perm filename TEST.LST[HAL,HE]1 blob sn#139767 filedate 1975-01-15 generic text, type T, neo UTF8
	PALX 222	01/15/75  13:42:22	PAGE 1
	TEST PAL[HAL,HE]	PAGE 1 	

				COMMENT ⊗   VALID 00004 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00002 00002	GENERAL PURPOSE TEST ROUTINE
				C00003 00003	UTILITY INPUT ROUTINES FOR DEBUGGING INTERP
				C00008 00004	 program initialization
				C00011 ENDMK
					C⊗;
	PALX 222	01/15/75  13:42:22	PAGE 2
	TEST PAL[HAL,HE]	PAGE 2 	

					;GENERAL PURPOSE TEST ROUTINE
					
					.INSRT HALHED.PAL[HAL,HE]
	PALX 222	01/15/75  13:42:22	PAGE 3
	HALHED PAL[HAL,HE]	PAGE 1 	

				COMMENT ⊗   VALID 00005 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00002 00002	.SBTTL  ASSEMBLY FLAGS
				C00005 00003	routine calling and defining macros.
				C00008 00004	macros for handling tables & blocks
				C00012 00005	Graph structure definitions
				C00014 ENDMK
					C⊗;
	PALX 222	01/15/75  13:42:22	PAGE 4
	HALHED PAL[HAL,HE]	PAGE 2 	ASSEMBLY FLAGS

					.SBTTL  ASSEMBLY FLAGS
					
					;This macro gives the switch SW a default value VAL
					       .MACRO STSW SW,VAL
					       .IFNDF SW
						SW == VAL   ;if do not have a value already, give it one
					       .ENDC
					       .ENDM
					
						STSW  FLOAT,1	;0 => no floating point capacity
					       .IFNDF FLOAT
						FLOAT == 1   ;if do not have a value already, give it one
					       .ENDC
					
					.SBTTL	DEFS -- standard definitions for HAL runtime routines
					
					; PROGRAM DEFINITIONS
					
		000004			ERRTRP==4		;time out and error trap
		000010			ILGINS==10		;illegal instruction
		000104			CLKTRP==104		;clock trap
		050000			RUG=50000		;Restart of RUG
		177776			PS=177776		;processor status word
		177560			KBIS=177560		;keyboard input status
		177562			KBIR=177562		;keyboard input register
		177564			KBOS=177564		;keyboard output status
		177566			KBOR=177566		;keyboard output register
		172544			CLKCNT=172544		;clock counter
		172542			CLKSET=172542		;clock set register
		172540			CLKS=172540		;clock status
					
		000500			STRT11=500		;starting address of program
		000150			IBUF==150		;start of input buffer from 11
		000160			OBUF==160		;start of output buffer to 11 
		077776			HCOR=77776		;highest useable word in core
					
					
					;REGISTER DEFINITIONS
					
		000007			PC=%7			;program counter
		000006			SP=%6			;stack pointer
		000005			RF==%5			;Display pointer
		000005			R5=%5
		000004			R4=%4			;Saved across procedure calls
		000003			R3=%3			;Saved across procedure calls
		000002			R2=%2			;Saved across procedure calls
		000001			R1=%1			;temp
		000000			R0=%0			;temp
		000005			AC5==%5			;Temp Floating point register
	PALX 222	01/15/75  13:42:22	PAGE 5
	HALHED PAL[HAL,HE]	PAGE 2.1 	DEFS -- standard definitions for HAL runtime routines

		000004			AC4==%4			; "      "       "      "
		000003			AC3==%3			; "      "       "      "
		000002			AC2==%2			; "      "       "      "
		000001			AC1==%1			; "      "       "      "
		000000			AC0==%0			; "      "       "      "
					
					;MARK DEFINITIONS
		006400			MARK0 == 6400		;MARK 0
		006401			MARK1 == 6401		;MARK 1
		006402			MARK2 == 6402		;ETC.
		006403			MARK3 == 6403
		006404			MARK4 == 6404
		006405			MARK5 == 6405
					
					;Absolute address initialization
		000000			TEMP == .		;Save location counter for a bit.
		000244			. = 244			;Floating exception
	000244	000246				.WORD 246
	000246	000002				RTI		;No action taken
		000000			. = TEMP		;Restore location counter
	PALX 222	01/15/75  13:42:22	PAGE 6
	HALHED PAL[HAL,HE]	PAGE 3 	DEFS -- standard definitions for HAL runtime routines

					;routine calling and defining macros.
					;Coded by RHT 9/74.
					
					;This should be used at the start of routines which reference
					;	parameters off the RF stack.  It gives the parameters
					;	symbolic names for clarity of coding.
					;For example,
					;
					;	ROUTINE FOO,<A,B>
					;
					;Goes to
					;
					;	A==4
					;	B==2
					;FOO:
					
					       .MACRO ROUTINE ID,ARGS
					           .IFNB ARGS
						    NNNN==0
						       .IRP II,<ARGS>		;Raise NNNN to twice the number of args.
							NNNN==NNNN+2
						       .ENDM
						       .IRP II,<ARGS>		;Assign each arg NNNN and decrease same.
							.IFDF II
							   .IF1 
							   	.ERROR Multiple definition for II
							   .ENDC
							.IFF
							    II == NNNN
							    NNNN == NNNN-2
							.ENDC
						       .ENDM
						   .ENDC
					ID:
					       .ENDM
					
					;This is useful in calling rountines which reference parameters off
					;	the RF stack.  It sets up the stack properly, but does not
					;	save R0 or R1.
					
					       .MACRO CALL ID,ARGS
						MOV	RF,-(SP)	;Save RF
						NNNN == 6400		;This is a MARK 0 instruction
						   .IFNB ARGS
						       .IRP II,<ARGS>
							MOV	II,-(SP);Push an argument
							NNNN == NNNN+1	;Make NNNN the next MARK instruction.
						       .ENDM
						   .ENDC
	PALX 222	01/15/75  13:42:22	PAGE 7
	HALHED PAL[HAL,HE]	PAGE 3.1 	DEFS -- standard definitions for HAL runtime routines

						MOV	#NNNN,-(SP)	;Push the mark instruction.
						MOV	SP,RF		;Set up the display in RF.
						JSR	PC,ID		;Call the routine
					       .ENDM
					
					
					;This macro is a temporary(ha,ha) method of defining floating point
					;constants. LABIL is the constant name and MSB and LSB it's two
					;16bit octal parts.
					
					       .MACRO FP  LABIL,MSB,LSB
						.MACRO  LABIL
						 	.WORD	MSB,LSB	
						.ENDM
					       .ENDM
	PALX 222	01/15/75  13:42:22	PAGE 8
	HALHED PAL[HAL,HE]	PAGE 4 	DEFS -- standard definitions for HAL runtime routines

					;macros for handling tables & blocks
					
					       .MACRO	XX SYM			;Just gives SYM the next number.
						   .IFDF SYM
						       .IF1
						       .ERROR You are using SYM in two ways!!!
						       .ENDC
						   .IFF
						    SYM == II
						    II == II+2
						   .ENDC
					       .ENDM
					
					.MACRO PUTLOC	ADR,VAL
						II==.
						.= ADR
						VAL
						.=II
					.ENDM
					
					.MACRO TT INX,VAL
						.=II+INX
						VAL
					.ENDM
					
					;SMALL BLOCK DESCRIPTOR FORMAT
					
		000000				II == 0
						XX	IDFLAG	;ACTUALLY A BYTE -- GETS PUT IN ID PART OF TAG WORD
						   .IFDF IDFLAG
						       .IF1
						       .ERROR You are using IDFLAG in two ways!!!
						       .ENDC
						   .IFF
						    IDFLAG == II
						    II == II+2
						   .ENDC
						XX	MAPRTN	;ROUTINE TO BE CALLED ON MARK
						   .IFDF MAPRTN
						       .IF1
						       .ERROR You are using MAPRTN in two ways!!!
						       .ENDC
						   .IFF
						    MAPRTN == II
						    II == II+2
						   .ENDC
						XX	SIZE	;How many words for a value cell in this type block.
						   .IFDF SIZE
						       .IF1
	PALX 222	01/15/75  13:42:22	PAGE 9
	HALHED PAL[HAL,HE]	PAGE 4.1 	DEFS -- standard definitions for HAL runtime routines

						       .ERROR You are using SIZE in two ways!!!
						       .ENDC
						   .IFF
						    SIZE == II
						    II == II+2
						   .ENDC
						XX	NPERB	;NUMBER OF BLOCKS PER BUFFER
						   .IFDF NPERB
						       .IF1
						       .ERROR You are using NPERB in two ways!!!
						       .ENDC
						   .IFF
						    NPERB == II
						    II == II+2
						   .ENDC
						XX	GCFG	;SET IF THIS IS NOT A COLLECTABLE AREA
						   .IFDF GCFG
						       .IF1
						       .ERROR You are using GCFG in two ways!!!
						       .ENDC
						   .IFF
						    GCFG == II
						    II == II+2
						   .ENDC
						XX	NMIN	;MIN NUMBER OF FREE BLOCKS TO BE RETURNED BY GC
						   .IFDF NMIN
						       .IF1
						       .ERROR You are using NMIN in two ways!!!
						       .ENDC
						   .IFF
						    NMIN == II
						    II == II+2
						   .ENDC
						XX	NPCT	;MIN % OF FREE BLOCKS TO BE RETURNED BY GC
						   .IFDF NPCT
						       .IF1
						       .ERROR You are using NPCT in two ways!!!
						       .ENDC
						   .IFF
						    NPCT == II
						    II == II+2
						   .ENDC
						XX	NXTSID	;NEXT BLOCK ON ID CHAIN 
						   .IFDF NXTSID
						       .IF1
						       .ERROR You are using NXTSID in two ways!!!
						       .ENDC
						   .IFF
						    NXTSID == II
	PALX 222	01/15/75  13:42:22	PAGE 10
	HALHED PAL[HAL,HE]	PAGE 4.2 	DEFS -- standard definitions for HAL runtime routines

						    II == II+2
						   .ENDC
						XX	FFREE	;FREE LIST
						   .IFDF FFREE
						       .IF1
						       .ERROR You are using FFREE in two ways!!!
						       .ENDC
						   .IFF
						    FFREE == II
						    II == II+2
						   .ENDC
						XX	FSTBUF	;OLDEST BUFFER
						   .IFDF FSTBUF
						       .IF1
						       .ERROR You are using FSTBUF in two ways!!!
						       .ENDC
						   .IFF
						    FSTBUF == II
						    II == II+2
						   .ENDC
						XX	LSTBUF	;NEWEST BUFFER
						   .IFDF LSTBUF
						       .IF1
						       .ERROR You are using LSTBUF in two ways!!!
						       .ENDC
						   .IFF
						    LSTBUF == II
						    II == II+2
						   .ENDC
						XX	NALLOC	;NUMBER ALLOCATED
						   .IFDF NALLOC
						       .IF1
						       .ERROR You are using NALLOC in two ways!!!
						       .ENDC
						   .IFF
						    NALLOC == II
						    II == II+2
						   .ENDC
						XX	NFREE	;NUMBER FREE
						   .IFDF NFREE
						       .IF1
						       .ERROR You are using NFREE in two ways!!!
						       .ENDC
						   .IFF
						    NFREE == II
						    II == II+2
						   .ENDC
		000000				SPCHDR == II
					
	PALX 222	01/15/75  13:42:22	PAGE 11
	HALHED PAL[HAL,HE]	PAGE 4.3 	DEFS -- standard definitions for HAL runtime routines

					;; EACH BUFFER
		000000				II == 0
						XX	NXTBUF	;NEXT BUFFER
						   .IFDF NXTBUF
						       .IF1
						       .ERROR You are using NXTBUF in two ways!!!
						       .ENDC
						   .IFF
						    NXTBUF == II
						    II == II+2
						   .ENDC
						XX	PRVBUF	;PREVIOUS BUFFER
						   .IFDF PRVBUF
						       .IF1
						       .ERROR You are using PRVBUF in two ways!!!
						       .ENDC
						   .IFF
						    PRVBUF == II
						    II == II+2
						   .ENDC
						XX	LSTBLK	;ADDRESS OF LAST BLOCK IN THIS BUFFER
						   .IFDF LSTBLK
						       .IF1
						       .ERROR You are using LSTBLK in two ways!!!
						       .ENDC
						   .IFF
						    LSTBLK == II
						    II == II+2
						   .ENDC
						XX	FSTBLK	;POINTS AT FIRST LOCN
						   .IFDF FSTBLK
						       .IF1
						       .ERROR You are using FSTBLK in two ways!!!
						       .ENDC
						   .IFF
						    FSTBLK == II
						    II == II+2
						   .ENDC
		000000				BUFHDR == II
					
					;; EACH BLOCK
		000000				II == 0
		177777				TAG == -1	;≠0 MEANS INUSE (USED IN GC)
		177776				TAGID == -2	;USED TO HOLD AN "ID" FOR THIS RECORD
						XX	WORD0	;FIRST DATA WORD
						   .IFDF WORD0
						       .IF1
						       .ERROR You are using WORD0 in two ways!!!
						       .ENDC
	PALX 222	01/15/75  13:42:22	PAGE 12
	HALHED PAL[HAL,HE]	PAGE 4.4 	DEFS -- standard definitions for HAL runtime routines

						   .IFF
						    WORD0 == II
						    II == II+2
						   .ENDC
					
					;;GC METHODS
		000000				II == 0
						XX	METH	;ROUTINE TO CALL
						   .IFDF METH
						       .IF1
						       .ERROR You are using METH in two ways!!!
						       .ENDC
						   .IFF
						    METH == II
						    II == II+2
						   .ENDC
						XX	NXTMTH	;NEXT ON CHAIN
						   .IFDF NXTMTH
						       .IF1
						       .ERROR You are using NXTMTH in two ways!!!
						       .ENDC
						   .IFF
						    NXTMTH == II
						    II == II+2
						   .ENDC
					
					.MACRO MMETH ROUT
						ROUT
						0
					.ENDM
					
					;;SPECIAL SPACES
					.IF2
		000000				SIDHED == SIDCHN ;SO AUTOMATIC LINKAGE WORKS
					.ENDC
					
		000000			SIDCNT == 0;
		000000			SIDCHN == 0;
					
					.MACRO DEFSPC ID,MMRT,SZ,NPB,GCF,NMN,NPC
					    .IFNDF ID
						SIDCNT==SIDCNT+1
						ID==SIDCNT
					    .ENDC
					    II==.
					    .BLKW SPCHDR/2
						TT	IDFLAG,ID
						TT	MAPRTN,MMRT
						TT	SIZE,SZ
	PALX 222	01/15/75  13:42:22	PAGE 13
	HALHED PAL[HAL,HE]	PAGE 4.5 	DEFS -- standard definitions for HAL runtime routines

						TT	NPERB,NPB
						TT	GCFG,GCF
						TT	NMIN,NMN
						TT	NPCT,NPC
						TT	NXTSID,SIDCHN
						TT	FFREE,0
						TT	FSTBUF,0
						TT	LSTBUF,0
						TT	NALLOC,0
						TT	NFREE,0
					    .=II+SPCHDR
					    SIDCHN == II
					    .IF2
						.IFGE MAXIDF-ID
						    II==.
						    .=SIDTBL+<ID*2>
						    SIDCHN
						    .=II
						.ENDC
					    .ENDC
					.ENDM
					
		000030			MAXIDF == 30	;MAX INDEX INTO SIDTBL
					
	PALX 222	01/15/75  13:42:22	PAGE 14
	HALHED PAL[HAL,HE]	PAGE 5 	DEFS -- standard definitions for HAL runtime routines

					;Graph structure definitions
					;RHT 9/74
					
					;CELL LINKS
		000000				II==0
						XX	DATUM
						   .IFDF DATUM
						       .IF1
						       .ERROR You are using DATUM in two ways!!!
						       .ENDC
						   .IFF
						    DATUM == II
						    II == II+2
						   .ENDC
						XX	LINKF
						   .IFDF LINKF
						       .IF1
						       .ERROR You are using LINKF in two ways!!!
						       .ENDC
						   .IFF
						    LINKF == II
						    II == II+2
						   .ENDC
						XX	LINKB
						   .IFDF LINKB
						       .IF1
						       .ERROR You are using LINKB in two ways!!!
						       .ENDC
						   .IFF
						    LINKB == II
						    II == II+2
						   .ENDC
					
					;GRAPH NODES
		000000				II==0
						XX	NXTGN		;CHAIN OF ALL GNODES IN THE WORLD
						   .IFDF NXTGN
						       .IF1
						       .ERROR You are using NXTGN in two ways!!!
						       .ENDC
						   .IFF
						    NXTGN == II
						    II == II+2
						   .ENDC
						XX	PRVGN
						   .IFDF PRVGN
						       .IF1
						       .ERROR You are using PRVGN in two ways!!!
						       .ENDC
	PALX 222	01/15/75  13:42:22	PAGE 15
	HALHED PAL[HAL,HE]	PAGE 5.1 	DEFS -- standard definitions for HAL runtime routines

						   .IFF
						    PRVGN == II
						    II == II+2
						   .ENDC
						XX	INVMRK		;USED AS FLAG
						   .IFDF INVMRK
						       .IF1
						       .ERROR You are using INVMRK in two ways!!!
						       .ENDC
						   .IFF
						    INVMRK == II
						    II == II+2
						   .ENDC
						XX	GNVAL		;POINTER AT VALUE
						   .IFDF GNVAL
						       .IF1
						       .ERROR You are using GNVAL in two ways!!!
						       .ENDC
						   .IFF
						    GNVAL == II
						    II == II+2
						   .ENDC
						XX	GNDEPS		;DEPENDENT GRAPH NODES
						   .IFDF GNDEPS
						       .IF1
						       .ERROR You are using GNDEPS in two ways!!!
						       .ENDC
						   .IFF
						    GNDEPS == II
						    II == II+2
						   .ENDC
						XX	GNCLCS		;CALCULATOR LIST (DBL LINKED)
						   .IFDF GNCLCS
						       .IF1
						       .ERROR You are using GNCLCS in two ways!!!
						       .ENDC
						   .IFF
						    GNCLCS == II
						    II == II+2
						   .ENDC
						XX	GNCHGS		;CHANGE LIST
						   .IFDF GNCHGS
						       .IF1
						       .ERROR You are using GNCHGS in two ways!!!
						       .ENDC
						   .IFF
						    GNCHGS == II
						    II == II+2
						   .ENDC
	PALX 222	01/15/75  13:42:22	PAGE 16
	HALHED PAL[HAL,HE]	PAGE 5.2 	DEFS -- standard definitions for HAL runtime routines

					
					;CALCULATOR CELL
		000000				II==0
						XX	NXTCLC		;LIST LINK
						   .IFDF NXTCLC
						       .IF1
						       .ERROR You are using NXTCLC in two ways!!!
						       .ENDC
						   .IFF
						    NXTCLC == II
						    II == II+2
						   .ENDC
						XX	NEEDED		;LIST OF NEEDED NODES
						   .IFDF NEEDED
						       .IF1
						       .ERROR You are using NEEDED in two ways!!!
						       .ENDC
						   .IFF
						    NEEDED == II
						    II == II+2
						   .ENDC
						XX	FORM		;SOME SORT OF CODE TO EVAL
						   .IFDF FORM
						       .IF1
						       .ERROR You are using FORM in two ways!!!
						       .ENDC
						   .IFF
						    FORM == II
						    II == II+2
						   .ENDC
					
					;CHANGER CELL
		000000				II==0
						XX	NXTCHG
						   .IFDF NXTCHG
						       .IF1
						       .ERROR You are using NXTCHG in two ways!!!
						       .ENDC
						   .IFF
						    NXTCHG == II
						    II == II+2
						   .ENDC
						XX	CHGCOD
						   .IFDF CHGCOD
						       .IF1
						       .ERROR You are using CHGCOD in two ways!!!
						       .ENDC
						   .IFF
						    CHGCOD == II
	PALX 222	01/15/75  13:42:22	PAGE 17
	HALHED PAL[HAL,HE]	PAGE 5.3 	DEFS -- standard definitions for HAL runtime routines

						    II == II+2
						   .ENDC
					
	PALX 222	01/15/75  13:42:22	PAGE 18
	TEST PAL[HAL,HE]	PAGE 2.1 	DEFS -- standard definitions for HAL runtime routines

		000500			.=STRT11
					.INSRT HALIO.PAL[HAL,HE]
	PALX 222	01/15/75  13:42:22	PAGE 19
	HALIO PAL[HAL,HE]	PAGE 1 	DEFS -- standard definitions for HAL runtime routines

				COMMENT ⊗   VALID 00016 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00003 00002	.SBTTL	TTY output routines
				C00006 00003	 Useful macros for use of I/O routines
				C00009 00004	The following pages contain floating point input-output routines.
				C00010 00005	STRING TO FLOATING POINT NUMBER ROUTINE - "RELSCN".
				C00013 00006		[CONTINUATION OF "RELSCN"]
				C00016 00007		[CONTINUATION OF "RELSCN"]
				C00018 00008	ROUTINES TO SET AND RESTORE OUTPUT FORMAT - "FORMAT"&"RSTFOR"
				C00020 00009	FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE - "CVF"
				C00023 00010	FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE - "CVE"
				C00026 00011		[CONTINUATION OF "CVE"]
				C00027 00012	FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING  - "CVG"
				C00029 00013		PRINTING ROUTINE USED BY "CVF" & "CVE"
				C00032 00014	This is the end of the floating package.
				C00033 00015	VT05 INPUT ROUTINE - "INSTR"
				C00036 00016	LOCAL STORAGE AREA
				C00040 ENDMK
					C⊗;
	PALX 222	01/15/75  13:42:22	PAGE 20
	HALIO PAL[HAL,HE]	PAGE 2 	TTY output routines

					.SBTTL	TTY output routines
		000500			.EVEN
					;  Modified 5-Sep-74 by RF.  Originally written by KKP.
					
					;	Output a string, ending with a zero character. Pointer to start
					;	of string in R0.  Called in "simple" style.
					
	000500	010001			TYPSTR:	MOV R0,R1	;R1 ← LOC[STRING]
	000502	112100				MOVB (R1)+,R0	;R0 ← first byte of string
	000504	004767	000056		TSLOOP:	JSR PC,TYPCHR	;Type this one character
	000510	112100				MOVB (R1)+,R0	;R0 ← Next byte of string
	000512	001374				BNE TSLOOP	;If more to come, repeat.
	000514	000207				RTS PC		;Done
					
					
					; Routines to output numbers.  Argument in R0.
					; TYPDEC outputs in base 10, and TYPOCT in base 8.
					; Both use TYPDIG as a subroutine, putting the digit
					;	in R0.
					; TYPCHR is a general purpose character output routine.
					
	000516	012767	000012	000020	TYPDEC:	MOV #12,RADIX	;To output in base 10
	000524	000404				BR TYPDIG	;Go type it.
	000526	012767	000010	000010	TYPOCT:	MOV #8,RADIX	;To output in base 8.
	000534	000400				BR TYPDIG	;Go type it.
	000536	010001			TYPDIG:	MOV R0,R1	;Need dividend in R1, with R0 clear.
	000540	005000				CLR R0		;Clear upper half of dividend.
	000542	071027				DIV (PC)+,R0	;Divide argument in R0, R1 by radix.
	000544	000012			RADIX:	12		;Starts out in decimal.
	000546	001404				BEQ TYPOUT	;If quotient zero, then can print.
	000550	010146				MOV R1,-(SP)	;Else stack quotient
	000552	004767	177760			JSR PC,TYPDIG	;Recursive call.
	000556	012601				MOV (SP)+,R1	;Unstack last quotient
	000560	062701	000060		TYPOUT:	ADD #'0,R1	;Form TTY code for digit
	000564	010100				MOV R1,R0	;Need argument for TYPCHR in R0.
	000566	105767	176772		TYPCHR:	TSTB KBOS	;Is TTY available?
	000572	100375				BPL TYPCHR	;No.  Busy wait for it.
	000574	110067	176766			MOVB R0,KBOR	;Yes.  Output a byte to it.
	000600	022700	000012			CMP #12,R0	;Was it a line feed?
	000604	001007				BNE TYPRET	;If not that code, then done.
	000606	005000				CLR R0		;Otherwise, output 3 nulls.
	000610	004767	177752			JSR PC,TYPCHR	;
	000614	004767	177746			JSR PC,TYPCHR	;
	000620	004767	177742			JSR PC,TYPCHR	;
	000624	000207			TYPRET:	RTS PC		;Return.
					
					
	PALX 222	01/15/75  13:42:22	PAGE 21
	HALIO PAL[HAL,HE]	PAGE 3 	TTY output routines

					; Useful macros for use of I/O routines
					
					       .MACRO OUTSTR B	;Type string starting at B.
						MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
						MOV R1,-(SP)	;Save R1.
						MOV #B,R0	;Load up the string to be output
						JSR PC,TYPSTR	;Call the string output utility routine.
						MOV (SP)+,R1	;Restore R1.
						MOV (SP)+,R0	;Restore R0.
					       .ENDM
					
					       .MACRO NUMOUT	;Type out the number in AC0 with CVG using OUTBUF
						MOV R0,-(SP)	;Save the registers
						MOV R1,-(SP)
						STF AC0,-(SP)
						STF AC1,-(SP)
						MOV #OUTBUF,R0	;Use OUTBUF to construct the string
						JSR PC,CVG	;Convert floating point number to asc
						LDF (SP)+,AC1   ;Restore the floating point registers
						LDF (SP)+,AC0
						MOV #OUTBUF,R0	;Set pointer for i/o routine
						JSR PC,TYPSTR	;Type out the number
						MOV (SP)+,R1	;Restore the registers
						MOV (SP)+,R0
					       .ENDM
					
					       .MACRO ASCIE STR
					       .ASCIZ STR
					       .EVEN
					       .ENDM
					
					       .MACRO	CRLF
						OUTSTR CRLFX	;Carriage return, line feed.
					       .ENDM
					
	000626	   015		
	000627	   012			CRLFX: .ASCIZ /
	000630	   000		
					/
					
				RUGMES:	ASCIE </π
				--YOU'RE UNDER THE RUG
					π/>
	000631	   007		
	000632	   015		
	000633	   012			       .ASCIZ /π
	000634	   055		
	000635	   055		
	000636	   131		
	PALX 222	01/15/75  13:42:22	PAGE 22
	HALIO PAL[HAL,HE]	PAGE 3.1 	TTY output routines

	000637	   117		
	000640	   125		
	000641	   047		
	000642	   122		
	000643	   105		
	000644	   040		
	000645	   125		
	000646	   116		
	000647	   104		
	000650	   105		
	000651	   122		
	000652	   040		
	000653	   124		
	000654	   110		
	000655	   105		
	000656	   040		
	000657	   122		
	000660	   125		
	000661	   107		
	000662	   015		
	000663	   012			--YOU'RE UNDER THE RUG
	000664	   007		
	000665	   000		
					π/
		000666			       .EVEN
					
					       .MACRO HALERR MES	;Bad error.  Type message, call RUG.
						MOV R0,-(SP)	;Save R0.
						MOV R1,-(SP)	;Save R1.
						MOV #CRLFX,R0	;Move to new line
						JSR PC,TYPSTR	;
						MOV #MES,R0	;Type out message
						JSR PC,TYPSTR	;
						MOV #RUGMES,R0	;Type out RUGMES
						JSR PC,TYPSTR	;
						MOV (SP)+,R1	;Restore R1.
						MOV (SP)+,R0	;Restore R2.
						JMP RUG		;Go directly to RUG.
						BR .-4		;In case we return.
					       .ENDM
					
	PALX 222	01/15/75  13:42:22	PAGE 23
	HALIO PAL[HAL,HE]	PAGE 4 	TTY output routines

					;The following pages contain floating point input-output routines.
					;Coded by BES 9/74.
					
					
		000001			.IFNZ FLOAT
	PALX 222	01/15/75  13:42:22	PAGE 24
	HALIO PAL[HAL,HE]	PAGE 5 	TTY output routines

					;STRING TO FLOATING POINT NUMBER ROUTINE - "RELSCN".
					
					;THE FLOATING POINT NUMBER MUST BE OF THE FORM SIII.DDDESXX WHERE S IS
					;THE SIGN OF THE NUMBER, III IS THE INTEGER FIELD,  DDD IS THE DECIMAL
					;FIELD,  AND SXX  IS THE EXPONENT  AND ITS SIGN.   THE LENGTH OF  EACH
					;FIELD IS VARIABLE  BUT ONLY THE FIRST 8 DIGITS  ARE USED IN COMPUTING
					;THE F.P.   NUMBER.  EMPTY FIELDS ARE PERMITTED AND ALL LEADING SPACES
					;AND ZEROS ARE IGNORED.  THE LOCATION OF THE FIRST  BYTE OF THE STRING
					;MUST  BE LOADED INTO  R0 BEFORE  CALLING "RELSCN".   AFTER EXECUTION,
					;THIS ROUTINE LEAVES THE F.P. NUMBER IN REGISTER AC0 AND R0 POINTS  TO
					;THE BYTE FOLLOWING THE LAST DIGIT.  R1 CONTAINS AN ERROR CODE.  IF NO
					;NUMBER WAS FOUND, R1 IS  -1 ELSE R1 IS 0.  "RELSCN" IS  CALLED IN THE
					;"SIMPLE STYLE".
					
					;REGISTERS USED:
					;
					;	R0,R1,AC0 PASS ARGUMENTS
					;	NO OTHER REGISTERS AFFECTED
					
					.STITLE FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
					
					;"DIGIT" CHECKS FOR ASC DIGIT AND CONVERTS TO INTEGER IF IT IS
					
					.MACRO DIGIT NOTDIG
						CMP	R4,#60		;COMPARE TO ASC ZERO
						BLT	NOTDIG		;SKIP IF OUT OF RANGE
						CMP	R4,#71		;COMPARE TO ASC 9
						BGT	NOTDIG		;SKIP IF OUT OF RANGE
						BIC	#60,R4		;MASK OUT ASC BASE
					.ENDM
					
					;"CKSIGN" CHECKS FOR A - OR + CHARACTER AND SETS SIGN APPROPRIATELY
					
					.MACRO CKSIGN ISSIGN,NTSIGN,SIGN
						CMP	#53,R4		;IGNOR "+" CHARACTER
						BEQ	ISSIGN
						CMP	#55,R4		;CHECK IF ITS A "-" CHAR.
						BNE	NTSIGN		;EXIT IF ITS NOT
						INC	SIGN		;ELSE SET SIGN NON-ZERO
						JMP	ISSIGN
					.ENDM
					
					;START OF "RELSCN"
					
		000666			.EVEN
	000666	010246			RELSCN:	MOV	R2,-(SP)	;SAVE REGISTER
	000670	010346			      	MOV	R3,-(SP)	;SAVE REGISTER
	000672	010446				MOV	R4,-(SP)
	000674	005002			      	CLR	R2 		;RESET DIGIT COUNT
	PALX 222	01/15/75  13:42:22	PAGE 25
	HALIO PAL[HAL,HE]	PAGE 5.1 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

	000676	012703	000001			MOV	#1,R3		;SET DECIMAL POINT FLAG
	000702	012701	177777			MOV	#-1,R1		;INDICATE NO DIGITS ENCOUNTERED
	000706	170167	001474			LDFPS	STAT		;SET THE FFP STATUS WORD
	000712	170400			 	CLRF	AC0		;CLEAR THE NUMBER ACCUM
	000714	005067	001470			CLR	MSIGN		;ASSUME MANTISSA POSITIVE
	PALX 222	01/15/75  13:42:22	PAGE 26
	HALIO PAL[HAL,HE]	PAGE 6 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

						[CONTINUATION OF "RELSCN"]
					
					;PICK UP A CHARACTER AND CHECK FOR SIGN
					
	000720	112004			PICK:	MOVB	(R0)+,R4	;PICK UP A CHARACTER
	000722	005701				TST	R1		;CHECK IF DIGIT ENCOUNTERED
	000724	001412				BEQ	CHKDG		;SKIP IF TRUE
						CKSIGN	PICK,CHKDG,MSIGN	;CHECK FOR + OR - SIGN
	000726	022704	000053			CMP	#53,R4		;IGNOR "+" CHARACTER
	000732	001772				BEQ	PICK
	000734	022704	000055			CMP	#55,R4		;CHECK IF ITS A "-" CHAR.
	000740	001004				BNE	CHKDG		;EXIT IF ITS NOT
	000742	005267	001442			INC	MSIGN		;ELSE SET MSIGN NON-ZERO
	000746	000167	177746			JMP	PICK
					
					;CHECK IF CHARARCTER IS A DIGIT
					
					CHKDG:	DIGIT	CHKDP		;SKIP TO CHKDP IF NOT A DIGIT
	000752	020427	000060			CMP	R4,#60		;COMPARE TO ASC ZERO
	000756	002420				BLT	CHKDP		;SKIP IF OUT OF RANGE
	000760	020427	000071			CMP	R4,#71		;COMPARE TO ASC 9
	000764	003015				BGT	CHKDP		;SKIP IF OUT OF RANGE
	000766	042704	000060			BIC	#60,R4		;MASK OUT ASC BASE
	000772	171067	001742			MULF	TEN,AC0		;MULT DIGIT SUM BY 10
	000776	072427	000002			ASH	#2,R4		;MULTIPLY INDEX BY 4
	001002	172064	002434			ADDF	DGLST(R4),AC0	;ADD THE F.P./10 TO ACCUM
	001006	005001				CLR     R1    		;INDICATE DIGIT ENCOUNTERED
	001010	162702	000004			SUB     #4,R2		;DECREMENT DIGIT COUNT
	001014	000167	177700			JMP	PICK		;GO GET ANOTHER CHARACTER
					
					;CHECK IF THE CHARACTER IS A DECIMAL POINT
					
	001020	022704	000056		CHKDP:	CMP	#56,R4		;COMPARE CHARACTER TO DECIMAL PT
	001024	001007				BNE	RNORM		;SKIP IF NOT D.P.
	001026	005703			      	TST	R3		;CHECK IF DECIMAL POINT ALREADY SET
	001030	001405				BEQ	RNORM		;IF RESET THIS MUST BE A THE END OF THE MANT.
	001032	005002				CLR	R2		;START COUNTING FRACTIONAL DIGITS
	001034	005003				CLR	R3		;INDICATE D.P. SET
	001036	005001				CLR	R1		;INDICATE DIGIT ENCOUNTERED
	001040	000167	177654			JMP	PICK		;GO GET ANOTHER CHARACTER
					
					;CORRECT NUMBER FOR POWER OF TEN IF DIGITS FOUND
					
	001044	005701			RNORM:	TST	R1		;CHECK IF DIGITS FOUND
	001046	001004				BNE	CHKEX		;SKIP IF NONE
	001050	005703				TST	R3		;CHECK IF DECIMAL POINT SET
	001052	001002				BNE	CHKEX		;DONT NORMALIZE IF NO D.P.
	001054	171062	002734		    	MULF	TENLST(R2),AC0	;CORRECT DECIMAL POINT
					
	PALX 222	01/15/75  13:42:22	PAGE 27
	HALIO PAL[HAL,HE]	PAGE 6.1 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;CHECK IF E SIGN ENCOUNTERED
					
	001060	022704	000105		CHKEX:	CMP	#105,R4		;COMPARE TO E CHARACTER
	001064	001053				BNE	CHKDN		;SKIP IF NOT E
	001066	005701				TST	R1   		;CHECK IF NO DIGITS BEFORE E
	001070	001403				BEQ	EXCN
	001072	172467	001636			LDF	TENLST,AC0	;SET AC0=1 IF EXPONENT BUT NO DIGITS
	001076	005001				CLR	R1		;INDICATE DIGITS ENCOUNTERED
	001100	005067	001306		EXCN:	CLR	ESIGN		;ASSUME EXPONENT POSITIVE
	001104	005003				CLR	R3		;CLEAR EXPONENT ACCUMULATOR
	PALX 222	01/15/75  13:42:22	PAGE 28
	HALIO PAL[HAL,HE]	PAGE 7 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

						[CONTINUATION OF "RELSCN"]
					
	001106	112004				MOVB	(R0)+,R4	;GET NEXT CHARACTER
						CKSIGN	PIC2,DIG2,ESIGN	;CHECK FOR SIGN CHARACTER
	001110	022704	000053			CMP	#53,R4		;IGNOR "+" CHARACTER
	001114	001407				BEQ	PIC2
	001116	022704	000055			CMP	#55,R4		;CHECK IF ITS A "-" CHAR.
	001122	001005				BNE	DIG2		;EXIT IF ITS NOT
	001124	005267	001262			INC	ESIGN		;ELSE SET ESIGN NON-ZERO
	001130	000167	000000			JMP	PIC2
	001134	112004			PIC2:	MOVB	(R0)+,R4	;SIGN INCOUNTERED, GET NEXT CHAR.
					DIG2:	DIGIT	NORM		;EXTRACT DIGIT 
	001136	020427	000060			CMP	R4,#60		;COMPARE TO ASC ZERO
	001142	002412				BLT	NORM		;SKIP IF OUT OF RANGE
	001144	020427	000071			CMP	R4,#71		;COMPARE TO ASC 9
	001150	003007				BGT	NORM		;SKIP IF OUT OF RANGE
	001152	042704	000060			BIC	#60,R4		;MASK OUT ASC BASE
	001156	070327	000012			MUL	#10.,R3		;MULT EXPON REG BY 10.
	001162	060403				ADD	R4,R3		;ADD DIGIT TO EXPONENT REG
	001164	000167	177744			JMP	PIC2		;GO GET ANOTHER CHARACTER
					
	001170	005767	001216		NORM:	TST	ESIGN		;CHECK SIGN OF EXPONENT
	001174	001401				BEQ	.+4
	001176	005403				NEG	R3		;COMPLEMENT EXPONENT IF - SIGN
	001200	072327	000002			ASH	#2,R3		;MULT. INDEX BY 4 FOR F.P. NUMBERS
	001204	171063	002734			MULF	TENLST(R3),AC0	;ADJUST EXPONENT OF NUMBER
	001210	000167	000010			JMP	CDONE		;EXIT ROUTINE
					
					;CHECK IF END OF NUMBER
					
	001214	005704			CHKDN:	TST     R4		;COMPARE CHARACTER TO A NULL CHARACTER
	001216	001402				BEQ	CDONE		;EXIT IF IT IS, THIS IS THE END OF THE STR
	001220	005701				TST	R1		;TEST IF ANY DIGITS YET
	001222	002636				BLT	PICK		;IF NONE, KEEP SCANNING
					
					;NO MORE DIGITS - APPLY CORRECT SIGN TO NUMBER
					
	001224	012604			CDONE:	MOV	(SP)+,R4	;RESTORE REGISTERS
	001226	012603			     	MOV	(SP)+,R3
	001230	012602				MOV	(SP)+,R2
	001232	005300				DEC	R0		;POINT TO BREAK CHARACTER
	001234	005767	001150		    	TST	MSIGN		;TEST SIGN OF MANTISSA
	001240	001401				BEQ	.+4
	001242	170700				NEGF	AC0		;COMPLEMENT NUMBER IF SIGN NEGATIVE
	001244	000207				RTS	PC		;RETURN
	PALX 222	01/15/75  13:42:22	PAGE 29
	HALIO PAL[HAL,HE]	PAGE 8 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;ROUTINES TO SET AND RESTORE OUTPUT FORMAT - "FORMAT"&"RSTFOR"
					
					;THE TOTAL NUMBER OF CHARACTERS TO BE WRITTEN (WIDTH) SHOULD BE
					;LOADED INTO R0 AND THE NUMBER OF DECIMAL DIGITS (DIGITS) SHOULD
					;BE LOADED INTO R1 BEFORE CALLING THIS ROUTINE.  IN ALL CASES,
					;WIDTH SHOULD BE GREATER THAN OR EQUAL TO DIGIT+2.  "FORMAT" IS
					;CALLED BY THE "SIMPLE METHOD".
					
					;REGISTERS USED:
					;
					;	R0,R1 PASS ARGUMENTS
					;	NO OTHER REGISTERS AFFECTED
					
	001246	016767	001150	001152	FORMAT:	MOV	WIDTH,OLDW	;SAVE THE OLD WIDTH
	001254	016767	001144	001146		MOV	DIG,OLDD	;   AND DIG
	001262	162700	000002		       	SUB	#2,R0		;SUBTRACT SPACES FOR SIGN AND . FROM WIDTH
	001266	010067	001130			MOV	R0,WIDTH	;SAVE WIDTH OF I/O STRING - 2
	001272	010167	001126			MOV	R1,DIG		;SAVE THE NUMBER OF DECI. DIGITS
	001276	020001				CMP	R0,R1		;CHECK TO SEE THAT WIDTH.GE.DIGIT+2
	001300	002012				BGE	NFER		;SKIP IF SPACE ALLOWED, ELSE CORRECT
						OUTSTR	FERM		;TYPE OUT ERROR MESSAGE
	001302	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	001304	010146				MOV R1,-(SP)	;Save R1.
	001306	012700	001330			MOV #FERM,R0	;Load up the string to be output
	001312	004767	177162			JSR PC,TYPSTR	;Call the string output utility routine.
	001316	012601				MOV (SP)+,R1	;Restore R1.
	001320	012600				MOV (SP)+,R0	;Restore R0.
	001322	010167	001074			MOV	R1,WIDTH	;SET WIDTH=DIG+2
	001326	000207			NFER:	RTS	PC		;RETURN
					
	001330	   015		
	001331	   012			FERM:	.ASCIZ /
	001332	   106		
	001333	   117		
	001334	   122		
	001335	   115		
	001336	   101		
	001337	   124		
	001340	   124		
	001341	   111		
	001342	   116		
	001343	   107		
	001344	   040		
	001345	   105		
	001346	   122		
	001347	   122		
	001350	   117		
	001351	   122		
	001352	   015		
	PALX 222	01/15/75  13:42:22	PAGE 30
	HALIO PAL[HAL,HE]	PAGE 8.1 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

	001353	   012			FORMATTING ERROR
	001354	   000		
					/
		001356				.EVEN
					
					
					;ROUTINE TO RESTORE LAST FORMAT - "RSTFOR"
					
					;THE PREVIOUS FORMAT BECOMES THE CURRENT FORMAT.  THE CURRENT
					;FORMAT IS LOST FOREVER.  "RSTFOR" IS CALLED IN THE "SIMPLE 
					;METHOD".
					
					;REGISTERS USED:  NONE
					
	001356	016767	001044	001036	RSTFOR:	MOV	OLDW,WIDTH	;RESTORE WIDTH
	001364	016767	001040	001032		MOV	OLDD,DIG	;RESTORE DIG
	001372	000207				RTS	PC		;RETURN
	PALX 222	01/15/75  13:42:22	PAGE 31
	HALIO PAL[HAL,HE]	PAGE 9 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE - "CVF"
					
					;"CVF" - THE STRING GENERATED BY THIS ROUTINE IS SIMILAR TO "F" FORMAT
					;IN  FORTRAN.  IT  IS ASSUMED  THAT THE NUMBER  TO BE CONVERTED  IS IN
					;REGISTER AC0  AND R0  CONTAINS A  POINTER TO  THE FIRST  BYTE OF  THE
					;OUTPUT STRING.  THE NUMBER OF  CHARACTERS WRITTEN SHOULD FIRST BE SET
					;IN  A CALL  TO "FORMAT", ELSE  THE DEFAULT VALUES  ARE USED.   IF THE
					;INTEGER PART  OF  THE  NUMBER EXCEEDS  THE  FORMAT LIMITS  THE  FIRST
					;CHARACTER WRITTEN  IS A ">".   AFTER COMPLETION, "CVF"  LEAVES A NULL
					;CHARACTER FOLLOWING THE NUMBER STRING.  REGISTER R0 IS LEFT  POINTING
					;AT THE NULL CHARACTER.
					
					;REGISTERS USED:
					;
					;	R0,AC0 PASS ARGUMENTS
					;	R1,AC1 GARBAGED
					
	001374	170167	001006		CVF:	LDFPS	STAT		;SET THE FFP STATUS WORD
	001400	016701	001016		    	MOV	WIDTH,R1	;GET THE TOTAL NUMBER OF CHAR TO BE WRITTEN
	001404	166701	001014			SUB	DIG,R1		;DETERMINE THE MAG. OF THE M.S. DIGIT
	001410	010167	001016			MOV	R1,PT		;NOW HAVE # OF DIGITS BEFORE DECIMAL POINT
	001414	072127	000002			ASH	#2,R1		;X 4, USE AS INDEX INTO F.P. TABLE
	001420	005401				NEG	R1
	001422	171061	002734			MULF	TENLST(R1),AC0	;NORMALIZE NUMBER TO BETWEEN 0 AND .99999999
	001426	016701	000770			MOV	WIDTH,R1	;TOTAL # OF DIGITS TO R1
	001432	010246				MOV	R2,-(SP)	;SAVE THE REGISTERS
	001434	010346				MOV	R3,-(SP)
	001436	004767	000356			JSR	PC,PRTF		;TYPE OUT THE DIGITS
	001442	112710	000000			MOVB	#0,(R0)		;PUT A NULL CHARACTER AFTER THE STRING
	001446	012603				MOV	(SP)+,R3	;RESTORE THE REGISTERS
	001450	012602				MOV	(SP)+,R2
	001452	000207				RTS	PC		;RETURN
	PALX 222	01/15/75  13:42:22	PAGE 32
	HALIO PAL[HAL,HE]	PAGE 10 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE - "CVE"
					
					;"CVE" - SAME OPERATION AS "CVF" EXCEPT THAT OUTPUT IN FORTRAN "E" FORMAT
					
	001454	010246			CVE:	MOV	R2,-(SP)	;SAVE THE REGISTERS
	001456	010346				MOV 	R3,-(SP)
	001460	170167	000722			LDFPS	STAT		;SET THE FFP STATUS WORD
	001464	005067	000724		        CLR     EXPON		;RESET EXPONENT COUNT
	001470	012767	000001	000734		MOV	#1,PT		;SET COUNT TO PRINT 1 NUMBER BEFORE DECIMAL PT
	001476	016701	000720			MOV	WIDTH,R1	;SET COUNT FOR TOTAL NUMBER OF DIGITS TO BE SENT
	001502	162701	000004			SUB	#4,R1		;ADJUST FOR EXPONENT
	001506	170500				TSTF	AC0		;CHECK IF NUMBER IS ZERO
	001510	170000				CFCC			;TRANSFER CONDITIONAL CODES TO CPU
	001512	001446				BEQ	EPRT		;START PRINTING IF NUMBER IS 0.0
	001514	174067	000676		     	STF	AC0,NUM		;GET THE NUMBER TO BE CONVERTED
	001520	005367	000670			DEC	EXPON		;ADJUST EXPONENT FOR PRINTING 1 INT. DIGIT
	001524	016702	000666			MOV	NUM,R2		;LOAD THE EXPONENT AND MSB OF THE NUMBER
	001530	042702	100000			BIC	#100000,R2	;CONVERT TO ABSOLUTE VALUE
	001534	162702	000150			SUB	#150,R2		;ADJUST EXPONENT DOWN
	001540	002001				BGE	.+4
	001542	005002				CLR	R2		;LEAVE IT POSITIVE
	001544	070227	000233			MUL	#233,R2		;USE EXPONENT AND MSB AS INDEX INTO TEN TABLE
	001550	020227	000114			CMP	R2,#76.		;COMPARE TO 1.0@38
	001554	003402				BLE	.+6
	001556	012702	000114			MOV	#76.,R2		;IF LARGER, REPLACE BY 1.0@38
	001562	162702	000046		      	SUB	#38.,R2		;SHIFT INDEX INTO RANGE OF -38 TO +38
	001566	060267	000622			ADD	R2,EXPON	;ADJUST EXPONENT COUNT
	001572	072227	000002			ASH	#2,R2		;MULT INDEX BY 4 FOR FLOATING POINT NUMBERS
	001576	005402				NEG	R2
	001600	171062	002734			MULF	TENLST(R2),AC0	;NORMALIZE NUMBER INTO RANGE 0.0 TO 0.9999
	001604	174001				STF	AC0,AC1		;GET ABSOLUTE VALUE OF NUMBER
	001606	170601				ABSF	AC1
	001610	173567	001120			CMPF	TENLST,AC1	;CHECK IF NUMBER LESS THAN 1.0
	001614	170000				CFCC			;TRANSFER CONDITIONAL CODES TO CPU
	001616	003004				BGT	EPRT		;IF ITS BETWEEN 0.0 AND .99999, GO TO PNTF
	001620	171067	001104			MULF	TENTH,AC0	;ELSE MULT. BY 0.1 AND ADJUST EXPONENT
	001624	005267	000564		        INC	EXPON
	PALX 222	01/15/75  13:42:22	PAGE 33
	HALIO PAL[HAL,HE]	PAGE 11 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

						[CONTINUATION OF "CVE"]
					
	001630	004767	000164		EPRT:	JSR	PC,PRTF		;GO PRINT MANTISSA
	001634	112720	000105			MOVB	#105,(R0)+	;PUT A "E" CHAR INTO THE STRING
	001640	112720	000053			MOVB	#53,(R0)+	;ASSUME EXPONENT POSITIVE A OUTPUT A "+"
	001644	016703	000544			MOV	EXPON,R3	;TEST SIGN OF EXPONENT
	001650	002004				BGE	XPRT		;SKIP IF POSITIVE
	001652	112760	000055	177777		MOVB	#55,-1(R0)	;REPLACE "+" WITH "-"
	001660	005403				NEG	R3    		;MAKE EXPONENT POSITIVE
	001662	005002			XPRT:	CLR	R2		;CLEAR FOR DIVISION
	001664	071227	000012		     	DIV	#10.,R2		;SEPARATES TENS AND UNITS DIGIT
	001670	052702	000060			BIS	#60,R2		;CONVERT TO ASC AND PUT IN I/O BUFFER
	001674	110220				MOVB	R2,(R0)+
	001676	052703	000060			BIS	#60,R3
	001702	110320				MOVB	R3,(R0)+
	001704	112710	000000			MOVB	#0,(R0)		;PUT IN A NULL CHARACTER
	001710	012603				MOV	(SP)+,R3	;RESTORE THE REGISTERS
	001712	012602				MOV	(SP)+,R2
	001714	000207				RTS	PC		;RETURN
	PALX 222	01/15/75  13:42:22	PAGE 34
	HALIO PAL[HAL,HE]	PAGE 12 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING  - "CVG"
					
					;"CVG" - DETERMINES IF THE NUMBER IN AC0 CAN BE WRITTEN BY "CVF", IF
					;IT CAN, THEN CVF IS CALLED, ELSE THE NUMBER IS PRINTED USING "CVE".
					
	001716	170167	000464		CVG:	LDFPS	STAT		;LOAD THE FFP STATUS WORD
	001722	172500			    	LDF	AC0,AC1		;COPY THE  NUMBER
	001724	170000				CFCC			;TRANSFER THE CONDITIONAL CODES TO CPU
	001726	170601				ABSF	AC1		;CONVERT NUMBER TO ABSOLUTE VALUES
	001730	001430				BEQ	RUNF		;IF NUMBER = 0.0, EXECUTE CVF
	001732	016701	000466			MOV	DIG,R1		;GET THE NUMBER OF DECIMAL DIGITS TO BE TYPED
	001736	072127	000002			ASH	#2,R1		;MULT BY 4 TO USE A FLOATING POINT INDEX
	001742	171161	002734			MULF	TENLST(R1),AC1	;CHECK IF NUMBER SMALLER THAN 1.0@-DIG
	001746	173567	000762			CMPF	TENLST,AC1	;COMPARE TO 1.0
	001752	170000				CFCC			;TRANSFER CONDITIONAL CODES TO CPU
	001754	003013				BGT	RUNE		;IF LESS THAN 1.0@-DIG, PRINT USING CVE
	001756	016701	000440			MOV	WIDTH,R1	;GET THE TOTAL NUMBER OF DIGITS TO BE PRINTED
	001762	072127	000002			ASH	#2,R1		;USE THIS AS A F.P. INDEX
	001766	005401				NEG	R1
	001770	171161	002734			MULF	TENLST(R1),AC1	;CHECK IF GREATER THAN WIDTH-DIG LONG
	001774	173567	000734			CMPF	TENLST,AC1	;COMPARE TO 1.0
	002000	170000				CFCC			;TRANSFER CONDITIONAL CODES
	002002	002003				BGE	RUNF		;IF TOO LARGE, USE CVE
	002004	004767	177444		RUNE:	JSR	PC,CVE
	002010	000207				RTS	PC
	002012	004767	177356		RUNF:	JSR	PC,CVF
	002016	000207				RTS	PC
	PALX 222	01/15/75  13:42:22	PAGE 35
	HALIO PAL[HAL,HE]	PAGE 13 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;	PRINTING ROUTINE USED BY "CVF" & "CVE"
					
	002020	170500			PRTF:	TSTF	AC0		;TEST THE SIGN OF THE NUMBER
	002022	112767	000040	000360		MOVB	#40,MSIGN	;ASSUME SIGN POSITIVE
	002030	170000				CFCC			;TRANSFER THE CONDITIONAL CODES TO CPU
	002032	170600				ABSF	AC0		;CLEAR THE SIGN OF THE NUMBER
	002034	002003				BGE	.+10		
	002036	112767	000055	000344	  	MOVB	#55,MSIGN	;IF NEGATIVE PUT IN "-" SIGN
	002044	171467	000670			MODF	TEN,AC0		;COMPUTE M.S. INTEGER DIGIT
	002050	005003				CLR	R3		;INDICATE SIGN NOT YET WRITTEN
	002052	005767	000354		DIGLP:	TST	PT		;CHECK IF TIME TO PRINT DECIMAL POINT
	002056	001007				BNE	GETDG		;SKIP IF NOT
	002060	005703				TST	R3		;HAVE WE PRINTED SIGN YET?
	002062	001003				BNE	WTDP		;SKIP IF WE HAVE
	002064	116720	000320			MOVB	MSIGN,(R0)+	;ELSE PRINT SIGN BEFORE DECIMAL POINT
	002070	005203				INC	R3		;INDICATE SIGN PRINTED
	002072	112720	000056		WTDP:	MOVB	#56,(R0)+	;PRINT DECIMAL POINT
	002076	175502			GETDG:	STCFI	AC1,R2 		;SAVE M.S. INTEGER DIGIT
	002100	170000				CFCC			;CHECK FOR NUMBER TOO LARGE TO INTEGERIZE
	002102	103015				BCC	CHKSZ
	002104	172001			TOLGE:	ADDF	AC1,AC0		;IF TWO LARGE, PUT IT BACK TOGETHER
	002106	171467	000616			MODF	TENTH,AC0	;SCALE DOWN AND TRY INTEGERIZING AGAIN
	002112	005201				INC	R1		;PRINT OUT ONE MORE DIGIT
	002114	005267	000312			INC	PT		;SHIFT DECIMAL POINT TO PUT IN EXTRA DIGIT
	002120	005703				TST	R3		;CHECK IF SIGN AND D.P. ALREADY WRITTEN
	002122	001765				BEQ	GETDG		;GO CHECK IF IN RANGE IF NOT WRITTEN
	002124	005003				CLR	R3		;CLEAR SIGN AND D.P.
	002126	162700	000002			SUB	#2,R0		;ADJUST BYTE POINTER
	002132	000167	177740			JMP	GETDG		;GO CHECK IF IN RANGE AGAIN
	002136	005702			CHKSZ:	TST     R2              ;TEST INTEGER
	002140	002761				BLT	TOLGE		;IF TOO LARGE, GO SCALE AGAIN
	002142	020227	000011			CMP	R2,#9.		;CHECK IF LESS THAN 9
	002146	003356				BGT	TOLGE		;SCALE IF GREATER THAN 9
	002150	171467	000564		      	MODF	TEN,AC0		;START COMPUTING NEXT INTEGER DIGIT
	002154	005703				TST	R3		;HAVE WE PRINTED SIGN YET?
	002156	001005				BNE	SETBS		;SKIP IF WE HAVE
	002160	005702				TST	R2		;CHECK IF LEADING ZERO
	002162	001407				BEQ	WTSP		;IF IT IS GO WRITE A SPACE CHARACTER
	002164	116720	000220			MOVB	MSIGN,(R0)+	;FIRST CHARACTER, NOW PRINT SIGN
	002170	005203				INC	R3		;INDICATE SIGN PRINTED
	002172	052702	000060		SETBS:	BIS	#60,R2		;SET ASC ZERO BASE
	002176	000167	000004			JMP	WTCH
	002202	112702	000040		WTSP:	MOVB	#40,R2		;WRITE A SPACE CHARACTER
	002206	110220			WTCH:	MOVB	R2,(R0)+	;PUT CHARACTER IN I/O BUFFER
	002210	005367	000216			DEC	PT		;DECREMENT DECIMAL POINT COUNT
	002214	077162				SOB	R1,DIGLP	;DONE WITH CHARACTERS?
	002216	000207				RTS	PC		;RETURN
	PALX 222	01/15/75  13:42:22	PAGE 36
	HALIO PAL[HAL,HE]	PAGE 14 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;This is the end of the floating package.
					.ENDC
	PALX 222	01/15/75  13:42:22	PAGE 37
	HALIO PAL[HAL,HE]	PAGE 15 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;VT05 INPUT ROUTINE - "INSTR"
					
					;STRING BYTE POINTER MUST BE  IN R0.  A CARRIAGE RETURN  IS ASSUMED TO
					;BE  THE  ACTIVATION CHARACTER.  A  RUB OUT  IS  A  DELETING BACKSPACE
					;CHARACTER.  AT  THE COMPLETION OF  THIS ROUTINE  A NULL CHARACTER  IS
					;PLACED IN THE INPUT STRING.  R0 THEN POINTS TO THE NULL CHARACTER.
					
					;REGISTERS USED:
					;
					;	R0 PASSES ARGUMENT
					;	R1 GARBAGED
					
	002220	005067	000154		INSTR:	CLR	CCNT		;RESET CHARACTER COUNT
	002224	105767	175330		IN2:  	TSTB	KBIS		;TEST IF KEYBOARD READY
	002230	001775				BEQ	.-4		;WAIT TILL IT IS
	002232	116701	175324			MOVB	KBIR,R1		;GET A CHARACTER
	002236	042701	177600			BIC     #177600,R1		;MASK OFF - MAKE IT 7 BITS
	002242	020127	000177			CMP	R1,#177		;COMPARE TO BS CHARACTER
	002246	001020				BNE	IN3		;SKIP IF ITS NOT
	002250	005767	000124			TST	CCNT		;CHECK IF ANY CHARACTERS IN BUFFER
	002254	001763				BEQ	IN2		;FORGET BACK SPACE IF NO CHAR.
	002256	005300				DEC     R0   		;REMOVE LAST CHARACTER IN BUFFER
	002260	005367	000114			DEC	CCNT		;DECREMENT CHARACTER COUNT
						OUTSTR  DBS		;PERFORM A DELETING BACKSPACE
	002264	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	002266	010146				MOV R1,-(SP)	;Save R1.
	002270	012700	002402			MOV #DBS,R0	;Load up the string to be output
	002274	004767	176200			JSR PC,TYPSTR	;Call the string output utility routine.
	002300	012601				MOV (SP)+,R1	;Restore R1.
	002302	012600				MOV (SP)+,R0	;Restore R0.
	002304	000167	177714			JMP     IN2
	002310	020127	000015		IN3:	CMP	R1,#15		;COMPARE TO CR CHARACTER
	002314	001415				BEQ     IN4   		;CONTINUE READING IF ITS NOT A CR
	002316	020127	000040			CMP	R1,#40		;CHECK IF CHARACTER LEGAL
	002322	002740				BLT	IN2		;IGNOR IF IT IS
	002324	110120			    	MOVB	R1,(R0)+	;SAVE THE CHARACTER
	002326	005267	000046		    	INC	CCNT		;INCREMENT CHARACTER COUNT
	002332	105767	175226		     	TSTB	KBOS		;ECHO THE CHARACTER
	002336	100375				BPL	.-4		;WAIT TILL TTY READY
	002340	110167	175222			MOVB	R1,KBOR		;WRITE THE CHARACTER
	002344	000167	177654			JMP	IN2		;CONTINUE READING
					IN4:  	CRLF			;IF IT IS A CR, TYPE A CR AND LF
						OUTSTR CRLFX	;Carriage return, line feed.
	002350	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	002352	010146				MOV R1,-(SP)	;Save R1.
	002354	012700	000626			MOV #CRLFX,R0	;Load up the string to be output
	002360	004767	176114			JSR PC,TYPSTR	;Call the string output utility routine.
	002364	012601				MOV (SP)+,R1	;Restore R1.
	002366	012600				MOV (SP)+,R0	;Restore R0.
	PALX 222	01/15/75  13:42:22	PAGE 38
	HALIO PAL[HAL,HE]	PAGE 15.1 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

	002370	110120				MOVB	R1,(R0)+	;PUT A CR IN THE STRING
	002372	112710	000000			MOVB    #0,(R0)		;PUT IN A NULL CHARACTER
	002376	000207				RTS	PC		;RETURN
	002400	000000			CCNT:	0
	002402	   010		
	002403	   040		
	002404	   010		
	002405	   000			DBS:	.BYTE	10,40,10,0
	PALX 222	01/15/75  13:42:22	PAGE 39
	HALIO PAL[HAL,HE]	PAGE 16 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;LOCAL STORAGE AREA
					
	002406	000000			STAT:	0		;FLOATING HARDWARE STATUS WORD
	002410	000000			MSIGN:	0		;SIGN OF CURRENT NUMBER
	002412	000000			ESIGN:	0		;SIGN OF EXPONENT
	002414	000000			EXPON:	0
	002416	000000		
	002420	000000			NUM:	.WORD  0,0
	002422	000010			WIDTH:	8. 		;DEFAULT NUMBER OF CHARACTERS IN OUTPUT STRING
	002424	000003			DIG:	3		;DEFAULT NUMBER OF DECIMAL DIGITS
	002426	000010			OLDW:	8.		;OLD VALUES OF WIDTH AND DIG
	002430	000003			OLDD:	3
	002432	000000			PT:	0		;NUMBER OF DIGITS BEFORE DECIMAL POINT
					
					;TABLE OF F.P. DIGITS FROM 0.0 TO 0.9
					
	002434	000000		
	002436	000000		
	002440	040200		
	002442	000000		
	002444	040400		
	002446	000000		
	002450	040500		
	002452	000000			DGLST:	.WORD        0,     0, 40200,     0, 40400,     0, 40500,     0
	002454	040600		
	002456	000000		
	002460	040640		
	002462	000000		
	002464	040700		
	002466	000000		
	002470	040740		
	002472	000000				.WORD    40600,     0, 40640,     0, 40700,     0, 40740,     0
	002474	041000		
	002476	000000		
	002500	041020		
	002502	000000				.WORD    41000,     0, 41020,     0
					
					;TABLE OF POWERS OF TEN
					
	002504	000531		
	002506	143735		
	002510	001410		
	002512	016352		
	002514	002252		
	002516	022044		
	002520	003124		
	002522	126455				.WORD      531,143735,  1410, 16352,  2252, 22044,  3124,126455
	002524	004004		
	002526	166074		
	PALX 222	01/15/75  13:42:22	PAGE 40
	HALIO PAL[HAL,HE]	PAGE 16.1 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

	002530	004646		
	002532	023513		
	002534	005517		
	002536	130436		
	002540	006401		
	002542	147263				.WORD     4004,166074,  4646, 23513,  5517,130436,  6401,147263
	002544	007242		
	002546	041140		
	002550	010112		
	002552	151370		
	002554	010775		
	002556	103666		
	002560	011636		
	002562	072321				.WORD     7242, 41140, 10112,151370, 10775,103666, 11636, 72321
	002564	012506		
	002566	011006		
	002570	013367		
	002572	113210		
	002574	014232		
	002576	137025		
	002600	015101		
	002602	066632				.WORD    12506, 11006, 13367,113210, 14232,137025, 15101, 66632
	002604	015761		
	002606	144400		
	002610	016627		
	002612	016640		
	002614	017474		
	002616	162410		
	002620	020354		
	002622	017112				.WORD    15761,144400, 16627, 16640, 17474,162410, 20354, 17112
	002624	021223		
	002626	111356		
	002630	022070		
	002632	073652		
	002634	022746		
	002636	112625		
	002640	023620		
	002642	016575				.WORD    21223,111356, 22070, 73652, 22746,112625, 23620, 16575
	002644	024464		
	002646	022334		
	002650	025341		
	002652	027023		
	002654	026214		
	002656	136314		
	002660	027057		
	002662	165777				.WORD    24464, 22334, 25341, 27023, 26214,136314, 27057,165777
	002664	027733		
	002666	163377		
	002670	030611		
	PALX 222	01/15/75  13:42:22	PAGE 41
	HALIO PAL[HAL,HE]	PAGE 16.2 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

	002672	070137		
	002674	031453		
	002676	146167		
	002700	032326		
	002702	137625				.WORD    27733,163377, 30611, 70137, 31453,146167, 32326,137625
	002704	033206		
	002706	033675		
	002710	034047		
	002712	142654		
	002714	034721		
	002716	133430		
	002720	035603		
	002722	011157				.WORD    33206, 33675, 34047,142654, 34721,133430, 35603, 11157
	002724	036443		
	002726	153412				.WORD    36443,153412 
	002730	037314		
	002732	146315			TENTH:	.WORD	 37314,146315 
	002734	040200		
	002736	000000			TENLST:	.WORD	 40200,     0 
	002740	041040		
	002742	000000			TEN:	.WORD	 41040,     0
	002744	041710		
	002746	000000		
	002750	042572		
	002752	000001		
	002754	043434		
	002756	040000		
	002760	044303		
	002762	050000				.WORD    41710,     0, 42572,     1, 43434, 40000, 44303, 50000
	002764	045164		
	002766	022001		
	002770	046030		
	002772	113200		
	002774	046676		
	002776	136040		
	003000	047556		
	003002	065451				.WORD    45164, 22001, 46030,113200, 46676,136040, 47556, 65451
	003004	050425		
	003006	001371		
	003010	051272		
	003012	041670		
	003014	052150		
	003016	152246		
	003020	053021		
	003022	102347				.WORD    50425,  1371, 51272, 41670, 52150,152246, 53021,102347
	003024	053665		
	003026	163041		
	003030	054543		
	003032	057652		
	PALX 222	01/15/75  13:42:22	PAGE 42
	HALIO PAL[HAL,HE]	PAGE 16.3 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

	003034	055416		
	003036	015712		
	003040	056261		
	003042	121275				.WORD    53665,163041, 54543, 57652, 55416, 15712, 56261,121275
	003044	057136		
	003046	005554		
	003050	060012		
	003052	143443		
	003054	060655		
	003056	074354		
	003060	061530		
	003062	153447				.WORD    57136,  5554, 60012,143443, 60655, 74354, 61530,153447
	003064	062407		
	003066	103170		
	003070	063251		
	003072	064027		
	003074	064123		
	003076	141034		
	003100	065004		
	003102	054522				.WORD    62407,103170, 63251, 64027, 64123,141034, 65004, 54522
	003104	065645		
	003106	067646		
	003110	066516		
	003112	145620		
	003114	067401		
	003116	037472		
	003120	070241		
	003122	107410				.WORD    65645, 67646, 66516,145620, 67401, 37472, 70241,107410
	003124	071111		
	003126	171312		
	003130	071774		
	003132	067575		
	003134	072635		
	003136	142656		
	003140	073505		
	003142	033432				.WORD    71111,171312, 71774, 67575, 72635,142656, 73505, 33432
	003144	074366		
	003146	102340		
	003150	075232		
	003152	011414		
	003154	076100		
	003156	113717		
	003160	076760		
	003162	136703				.WORD    74366,102340, 75232, 11414, 76100,113717, 76760,136703
	003164	077626		
	003166	073232				.WORD    77626, 73232
					
					;System line buffers
					
	PALX 222	01/15/75  13:42:22	PAGE 43
	HALIO PAL[HAL,HE]	PAGE 16.4 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

		003314			INBUF:	.BLKW	42.
		003440			OUTBUF:	.BLKW	42.
	PALX 222	01/15/75  13:42:22	PAGE 44
	TEST PAL[HAL,HE]	PAGE 2.2 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

					;INSRT HALRTR.PAL[HAL,HE]
					;INSRT GRAPHS.PAL[HAL,HE]
					;INSRT FBUG.PAL[1,BES]
					;INSRT ARITH.PAL[HAL,HE]
					.INSRT INTERP.PAL[HAL,HE]
	PALX 222	01/15/75  13:42:22	PAGE 45
	INTERP PAL[HAL,HE]	PAGE 1 	FLOATING POINT TO/FROM STRING CONVERSION ROUTINES

				COMMENT ⊗   VALID 00009 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00002 00002	.SBTTL Interpreter
				C00006 00003	Interpreter itself
				C00009 00004	GETARG:
				C00012 00005	GTVAL:	MOV @IPC(R4),R0	Pick up level-offset name of argument
				C00014 00006	Flow-of-control routines
				C00021 00007	Routines which return scalars
				C00026 00008	Routines which return vectors
				C00032 00009	routines which return a trans
				C00033 ENDMK
					C⊗;
	PALX 222	01/15/75  13:42:22	PAGE 46
	INTERP PAL[HAL,HE]	PAGE 2 	Interpreter

					.SBTTL Interpreter
					
					;Register uses in the interpreter:
					;	R3	interpreter stack pointer
					;	R4	points to interpreter status block
					
					;Each interpreter has a stack which it uses to store pointers to
					;currently "open" variables.  During the course of a calculation,
					;operands and temporary result cells will be open in this fashion.
					;The "interpreter stack" is pointed to by R3. When a new interpreter
					;is sprouted, it is given a new stack area. Each interpreter has
					;certain status information which facilitates transfer of control
					;between interpreters.  This information is kept in the interpreter
					;status block, which is always pointed to by R4.  Most important are
					;the IPC, the Interpreter Program Counter, the ENV, which points to
					;the local environment, and LEV, which stores the current lexical
					;level.
					
					;Each procedure has an environment, which is a data area holding
					;information vital to that procedure.  This includes pointers to all
					;the variables local to that procedure, and return information.
					
					;Interpreter status block
		000000				II == 0
						XX SR0	;Saved R0 (across waits)
						   .IFDF SR0
						       .IF1
						       .ERROR You are using SR0 in two ways!!!
						       .ENDC
						   .IFF
						    SR0 == II
						    II == II+2
						   .ENDC
						XX SR1	;Saved R1 (across waits)
						   .IFDF SR1
						       .IF1
						       .ERROR You are using SR1 in two ways!!!
						       .ENDC
						   .IFF
						    SR1 == II
						    II == II+2
						   .ENDC
						XX SR2	;Saved R2 (across waits)
						   .IFDF SR2
						       .IF1
						       .ERROR You are using SR2 in two ways!!!
						       .ENDC
						   .IFF
						    SR2 == II
	PALX 222	01/15/75  13:42:22	PAGE 47
	INTERP PAL[HAL,HE]	PAGE 2.1 	Interpreter

						    II == II+2
						   .ENDC
						XX SR3	;Saved R3 (across waits)
						   .IFDF SR3
						       .IF1
						       .ERROR You are using SR3 in two ways!!!
						       .ENDC
						   .IFF
						    SR3 == II
						    II == II+2
						   .ENDC
						XX SR4	;Saved R4 (across waits)
						   .IFDF SR4
						       .IF1
						       .ERROR You are using SR4 in two ways!!!
						       .ENDC
						   .IFF
						    SR4 == II
						    II == II+2
						   .ENDC
						XX SRF	;Saved RF (across waits)
						   .IFDF SRF
						       .IF1
						       .ERROR You are using SRF in two ways!!!
						       .ENDC
						   .IFF
						    SRF == II
						    II == II+2
						   .ENDC
						XX SSP	;Saved SP (across waits)
						   .IFDF SSP
						       .IF1
						       .ERROR You are using SSP in two ways!!!
						       .ENDC
						   .IFF
						    SSP == II
						    II == II+2
						   .ENDC
						XX SPC	;Saved PC (across waits)
						   .IFDF SPC
						       .IF1
						       .ERROR You are using SPC in two ways!!!
						       .ENDC
						   .IFF
						    SPC == II
						    II == II+2
						   .ENDC
						XX IPC	;Interpreter program counter
						   .IFDF IPC
	PALX 222	01/15/75  13:42:22	PAGE 48
	INTERP PAL[HAL,HE]	PAGE 2.2 	Interpreter

						       .IF1
						       .ERROR You are using IPC in two ways!!!
						       .ENDC
						   .IFF
						    IPC == II
						    II == II+2
						   .ENDC
						XX STKBAS ;Location of start of stack area.  Needed
						   .IFDF STKBAS
						       .IF1
						       .ERROR You are using STKBAS in two ways!!!
						       .ENDC
						   .IFF
						    STKBAS == II
						    II == II+2
						   .ENDC
							;for eventual reclamation.
						XX ICR	;Interpreter cross-reference (to HAL code)
						   .IFDF ICR
						       .IF1
						       .ERROR You are using ICR in two ways!!!
						       .ENDC
						   .IFF
						    ICR == II
						    II == II+2
						   .ENDC
						XX ENV	;Location of local environment
						   .IFDF ENV
						       .IF1
						       .ERROR You are using ENV in two ways!!!
						       .ENDC
						   .IFF
						    ENV == II
						    II == II+2
						   .ENDC
						XX LEV	;Lexical level of current execution
						   .IFDF LEV
						       .IF1
						       .ERROR You are using LEV in two ways!!!
						       .ENDC
						   .IFF
						    LEV == II
						    II == II+2
						   .ENDC
						XX STA	;Status bits for condition codes:  0 means all well.
						   .IFDF STA
						       .IF1
						       .ERROR You are using STA in two ways!!!
						       .ENDC
	PALX 222	01/15/75  13:42:22	PAGE 49
	INTERP PAL[HAL,HE]	PAGE 2.3 	Interpreter

						   .IFF
						    STA == II
						    II == II+2
						   .ENDC
		000000				ISBS = II/2	;Size (in words) of interpreter status block
					
					;Fixed fields in the environment of each process
		000000				II == 0
						XX SLINK 	;Pointer to environment of next (outer, lower
						   .IFDF SLINK
						       .IF1
						       .ERROR You are using SLINK in two ways!!!
						       .ENDC
						   .IFF
						    SLINK == II
						    II == II+2
						   .ENDC
								;  numbered) block
						XX OLEV		;Old level.  The lexical level of calling process.
						   .IFDF OLEV
						       .IF1
						       .ERROR You are using OLEV in two ways!!!
						       .ENDC
						   .IFF
						    OLEV == II
						    II == II+2
						   .ENDC
						XX OENV		;Old environment, the one for the calling process.
						   .IFDF OENV
						       .IF1
						       .ERROR You are using OENV in two ways!!!
						       .ENDC
						   .IFF
						    OENV == II
						    II == II+2
						   .ENDC
						XX OIPC		;Old IPC.  Program counter for calling process.
						   .IFDF OIPC
						       .IF1
						       .ERROR You are using OIPC in two ways!!!
						       .ENDC
						   .IFF
						    OIPC == II
						    II == II+2
						   .ENDC
						XX LVARS	;First location where pointers to local variables go
						   .IFDF LVARS
						       .IF1
						       .ERROR You are using LVARS in two ways!!!
	PALX 222	01/15/75  13:42:22	PAGE 50
	INTERP PAL[HAL,HE]	PAGE 2.4 	Interpreter

						       .ENDC
						   .IFF
						    LVARS == II
						    II == II+2
						   .ENDC
					
	PALX 222	01/15/75  13:42:22	PAGE 51
	INTERP PAL[HAL,HE]	PAGE 3 	Interpreter

					;Interpreter itself
	003440	017400	000020		INTERP:	MOV @IPC(R4),R0	;R0 ← next instruction
	003444	002415				BLT INTER1	;Instruction out of range
	003446	020067	174374			CMP R0,INSEND	;Is instruction too large?
	003452	101012				BHI INTER1	;Yes.
	003454	062764	000002	000020		ADD #2,IPC(R4)	;Bump IPC
	003462	004770	003614			JSR PC,@INTOPS(R0)	;Call the appropriate routine
	003466	000400				BR  INTCPL(R0)	;R0 should have an completion code.  Branch accordingly.
					
	003470	000402			INTCPL: BR  INTSTS	;No error.  Gather statistics.
	003472	000167	044302			JMP RUG		;Error.  Temporarily, just go to RUG.
					
	003476	000760			INTSTS: BR  INTERP	;No statistics code written yet.
					
					INTER1:	HALERR INTMS1
	003500	010046				MOV R0,-(SP)	;Save R0.
	003502	010146				MOV R1,-(SP)	;Save R1.
	003504	012700	000626			MOV #CRLFX,R0	;Move to new line
	003510	004767	174764			JSR PC,TYPSTR	;
	003514	012700	003546			MOV #INTMS1,R0	;Type out message
	003520	004767	174754			JSR PC,TYPSTR	;
	003524	012700	000631			MOV #RUGMES,R0	;Type out RUGMES
	003530	004767	174744			JSR PC,TYPSTR	;
	003534	012601				MOV (SP)+,R1	;Restore R1.
	003536	012600				MOV (SP)+,R0	;Restore R2.
	003540	000167	044234			JMP RUG		;Go directly to RUG.
	003544	000775				BR .-4		;In case we return.
					INTMS1:	ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/
	003546	   111		
	003547	   116		
	003550	   124		
	003551	   105		
	003552	   122		
	003553	   120		
	003554	   122		
	003555	   105		
	003556	   124		
	003557	   105		
	003560	   122		
	003561	   040		
	003562	   111		
	003563	   116		
	003564	   123		
	003565	   124		
	003566	   122		
	003567	   125		
	003570	   103		
	003571	   124		
	003572	   111		
	PALX 222	01/15/75  13:42:22	PAGE 52
	INTERP PAL[HAL,HE]	PAGE 3.1 	Interpreter

	003573	   117		
	003574	   116		
	003575	   040		
	003576	   117		
	003577	   125		
	003600	   124		
	003601	   040		
	003602	   117		
	003603	   106		
	003604	   040		
	003605	   122		
	003606	   101		
	003607	   116		
	003610	   107		
	003611	   105		
	003612	   000		
					       .ASCIZ /INTERPRETER INSTRUCTION OUT OF RANGE/
		003614			       .EVEN
					
					INTOPS:
						;Stack operations
	003614	004062				GTVAL ;a	;Push value of arg (level-offset pair).
	003616	004126				CHNGE ;a	;Pop value into arg (level-offset pair).
	003620	004166				POP		;Pop stack.
	003622	004174				COPY ;n		;Copy n'th down to top of stack.
	003624	004216				FLUSH		;Flush the entire stack.
					
						;Flow of control
	003626	004226				PROC ;d,al	;Call a procedure at d, with arg list al.
	003630	004434				RETURN		;Return from procedure
	003632	004472				SPROUT ;d	;Sprout an interpreter at d.
					
						;Arithmetic
	003634	004574				SAS		;S+S:  Add top two elts, pop, pop, push answer
	003636	004612				SMS		;S*S:  Mul top two elts, pop, pop, push answer
	003640	004630				SDS		;S/S:  Div top two elts, pop, pop, push answer
	003642	004650				NS		;-S:   Negate top elt, pop, push answer
	003644	004666				VDV		;S ← vector dot vector
	003646	004732				PDV		;Scalar ← plane dot vector
	003650	004772				NRMV		;Scalar ← norm of vector
	003652	005036				SMV		;Vector ← scalar * vector
	003654	005076				UNITV		;Vector ← vector / its norm
	003656	005170				CROSV		;Vector ← vector cross vector
	003660	005324				TMV		;Vector ← trans * vector
					
		000046				INSEND = .-INTOPS;Marks the end of the instructions
	PALX 222	01/15/75  13:42:22	PAGE 53
	INTERP PAL[HAL,HE]	PAGE 4 	Interpreter

					GETARG:
					;Arguments:  
					;  R0=variable name:  low byte is lexical level, high byte is offset.
					;  R4=pointer to interpreter status block.
					;Result:
					;  R0← pointer to address of desired variable.  
					;  R1 clobbered.
					;This routine returns in R0 a pointer to the location in the current
					;  environment (or, if necessary, more global environment) which
					;  points to the variable which is named in R0. 
	003662	010246				MOV R2,-(SP)	;Save R2
	003664	110001				MOVB R0,R1	;R1 ← Lexical level desired
	003666	105000				CLRB R0		;
	003670	000300				SWAB R0		;R0 ← Offset
	003672	016402	000026			MOV ENV(R4),R2	;R2 ← LOC[local environment]
	003676	166401	000030			SUB LEV(R4),R1	;R1 ← Difference in levels: desired-got
	003702	001405				BEQ GTRG1	;Diff=0; can use R2 as pointer at right base.
	003704	101007				BHI GTERR	;If diff>0, then value inaccessible.
	003706	016202	000000		GTRG2:	MOV SLINK(R2),R2;Must go up a level.  R2 ← LOC[more global environment]
	003712	005201				INC R1		;R1 ← New difference in levels
	003714	001374				BNE GTRG2	;If not yet good, then move up another level
	003716	060200			GTRG1:	ADD R2,R0	;R0 ← environment + offset = location of desired pointer
	003720	012602				MOV (SP)+,R2	;Restore R2.
	003722	000207				RTS PC		;Done.
					GTERR:	HALERR GTMS1
	003724	010046				MOV R0,-(SP)	;Save R0.
	003726	010146				MOV R1,-(SP)	;Save R1.
	003730	012700	000626			MOV #CRLFX,R0	;Move to new line
	003734	004767	174540			JSR PC,TYPSTR	;
	003740	012700	003772			MOV #GTMS1,R0	;Type out message
	003744	004767	174530			JSR PC,TYPSTR	;
	003750	012700	000631			MOV #RUGMES,R0	;Type out RUGMES
	003754	004767	174520			JSR PC,TYPSTR	;
	003760	012601				MOV (SP)+,R1	;Restore R1.
	003762	012600				MOV (SP)+,R0	;Restore R2.
	003764	000167	044010			JMP RUG		;Go directly to RUG.
	003770	000775				BR .-4		;In case we return.
					GTMS1:	ASCIE /ATTEMPT TO ACCESS UNAVAILABLE VARIABLE/
	003772	   101		
	003773	   124		
	003774	   124		
	003775	   105		
	003776	   115		
	003777	   120		
	004000	   124		
	004001	   040		
	004002	   124		
	004003	   117		
	004004	   040		
	PALX 222	01/15/75  13:42:22	PAGE 54
	INTERP PAL[HAL,HE]	PAGE 4.1 	Interpreter

	004005	   101		
	004006	   103		
	004007	   103		
	004010	   105		
	004011	   123		
	004012	   123		
	004013	   040		
	004014	   125		
	004015	   116		
	004016	   101		
	004017	   126		
	004020	   101		
	004021	   111		
	004022	   114		
	004023	   101		
	004024	   102		
	004025	   114		
	004026	   105		
	004027	   040		
	004030	   126		
	004031	   101		
	004032	   122		
	004033	   111		
	004034	   101		
	004035	   102		
	004036	   114		
	004037	   105		
	004040	   000		
					       .ASCIZ /ATTEMPT TO ACCESS UNAVAILABLE VARIABLE/
		004042			       .EVEN
					
					GETSCA:	;Gets place for a scalar result, and places a pointer on
						;the interpreter stack.  Location is returned in R0.  
						;Simple procedure.
					;	MOV #2,R0	;Number of words needed
					;	JSR PC,GETSMA	;R0 ← LOC[new block]
	004042	012700	006040			MOV #RES,R0	;Temporary kludge.  Delete this line in final runs.
	004046	010043				MOV R0,-(R3)	;Push new value cell pointer on interpreter stack.
	004050	000207				RTS PC		;Done
					
					GETVEC:	;Gets place for a vector result, and places a pointer on
						;the interpreter stack.  Location is returned in R0.  
						;Simple procedure.
					;	MOV #10,R0	;Number of words needed
					;	JSR PC,GETSMA	;R0 ← LOC[new block]
	004052	012700	006040			MOV #RES,R0	;Temporary kludge.  Delete this line in final runs.
	004056	010043				MOV R0,-(R3)	;Push new value cell pointer on interpreter stack.
	004060	000207				RTS PC		;Done
					
	PALX 222	01/15/75  13:42:22	PAGE 55
	INTERP PAL[HAL,HE]	PAGE 5 	Interpreter

	004062	017400	000020		GTVAL:	MOV @IPC(R4),R0	;Pick up level-offset name of argument
	004066	062764	000002	000020		ADD #2,IPC(R4)	;Bump IPC
	004074	004767	177562			JSR PC,GETARG	;R0 ← LOC[LOC[desired graph node]]
	004100	011000				MOV (R0),R0	;R0 ← LOC[desired graph node]
						CALL GETVAL,<R0>;R0 ← value
	004102	010546				MOV	RF,-(SP)	;Save RF
		006400				NNNN == 6400		;This is a MARK 0 instruction
						   .IFNB R0
						       .IRP II,<R0>
							MOV	II,-(SP);Push an argument
							NNNN == NNNN+1	;Make NNNN the next MARK instruction.
						       .ENDM
	004104	010046					MOV	R0,-(SP);Push an argument
		006401					NNNN == NNNN+1	;Make NNNN the next MARK instruction.
						   .ENDC
	004106	012746	006401			MOV	#NNNN,-(SP)	;Push the mark instruction.
	004112	010605				MOV	SP,RF		;Set up the display in RF.
GTVAL+32	4114	5	6	GETVAL	UNDEFINED
	004114	004767	173660			JSR	PC,GETVAL		;Call the routine
	004120	010043				MOV R0,-(R3)	;Push value on interpreter stack.
	004122	005000				CLR R0		;Clear condition code.
	004124	000207				RTS PC		;Done
					
	004126	017400	000020		CHNGE:	MOV @IPC(R4),R0	;Pick up level-offset name of argument
	004132	062764	000002	000020		ADD #2,IPC(R4)	;Bump IPC
	004140	004767	177516			JSR PC,GETARG	;R0 ← LOC[LOC[Desired graph node]]
	004144	011000				MOV (R0),R0	;R0 ← LOC[Desired graph node]
						CALL CHANGE,<R0,(R3)>
	004146	010546				MOV	RF,-(SP)	;Save RF
		006400				NNNN == 6400		;This is a MARK 0 instruction
						   .IFNB R0,(R3)
						       .IRP II,<R0,(R3)>
							MOV	II,-(SP);Push an argument
							NNNN == NNNN+1	;Make NNNN the next MARK instruction.
						       .ENDM
	004150	010046					MOV	R0,-(SP);Push an argument
		006401					NNNN == NNNN+1	;Make NNNN the next MARK instruction.
	004152	011346					MOV	(R3),-(SP);Push an argument
		006402					NNNN == NNNN+1	;Make NNNN the next MARK instruction.
						   .ENDC
	004154	012746	006402			MOV	#NNNN,-(SP)	;Push the mark instruction.
	004160	010605				MOV	SP,RF		;Set up the display in RF.
CHNGE+34	4162	5	15	CHANGE	UNDEFINED
	004162	004767	173612			JSR	PC,CHANGE		;Call the routine
	004166	005723			POP:	TST (R3)+	;Pop stack
	004170	005000				CLR R0		;Clear condition code.
	004172	000207				RTS PC		;Done
					
	004174	017400	000020		COPY:	MOV @IPC(R4),R0	;Pick up argument.
	PALX 222	01/15/75  13:42:22	PAGE 56
	INTERP PAL[HAL,HE]	PAGE 5.1 	Interpreter

	004200	062764	000002	000020		ADD #2,IPC(R4)	;Bump IPC
	004206	060300				ADD R3,R0	;R0 ← LOC[stack element to be copied to top]
	004210	011043				MOV (R0),-(R3)	;Copy it onto top of stack.
	004212	005000				CLR R0		;Clear condition code.
	004214	000207				RTS PC		;Done
					
	004216	016403	000022		FLUSH:	MOV STKBAS(R4),R3;Reset the stack base.
	004222	005000				CLR R0		;Clear condition code.
	004224	000207				RTS PC		;Done
	PALX 222	01/15/75  13:42:22	PAGE 57
	INTERP PAL[HAL,HE]	PAGE 6 	Interpreter

					;Flow-of-control routines
					
					;Procedure call.  Arguments: 
					;	Destination.
					;	List of variables which are to be inserted in appropriate 
					;	  locations in the local storage of procedure.  These are
					;	  in the format variable (ie level-offset pair), new offset
					;	  (right justified in the second word).
					;	  There is a zero word to finish these.
					;At the destination address can be found:
		000000				II == 0
						XX FSLGTH	;Number of words to get from free storage 
						   .IFDF FSLGTH
						       .IF1
						       .ERROR You are using FSLGTH in two ways!!!
						       .ENDC
						   .IFF
						    FSLGTH == II
						    II == II+2
						   .ENDC
								;for local variable pointers
						XX PLEV		;Lexical level of procedure
						   .IFDF PLEV
						       .IF1
						       .ERROR You are using PLEV in two ways!!!
						       .ENDC
						   .IFF
						    PLEV == II
						    II == II+2
						   .ENDC
		000000				DSLGTH == II	;Number of words before code starts
					;Value parameters should have first been copied first into local temps
					;  (which have been arranged by the compiler), and then the temps are
					;  passed by reference.  Eventual problem: to know which variables to
					;  really kill as the procedure is exited. 
					
	004226	010246			PROC:	MOV R2,-(SP)	;Save R2
	004230	017402	000020			MOV @IPC(R4),R2	;R2 ← LOC[destination]
	004234	062764	000002	000020		ADD #2,IPC(R4)	;Bump IPC
	004242	016200	000000			MOV FSLGTH(R2),R0	;R0 ← Number of words to get.
PROC+20		4246	6	25	GTFREE	UNDEFINED
	004246	004767	173526			JSR PC,GTFREE	;R0 ← LOC[block with that number of words]
					
					      ;initialize pointer to lexical level:
	004252	016201	000002			MOV PLEV(R2),R1	;R1 ← Lexical level of procedure
	004256	016402	000026			MOV ENV(R4),R2	;R2 ← LOC[current environment]
	004262	166401	000030			SUB LEV(R4),R1	;R1 ← Difference in levels: desired-got
	004266	001404				BEQ PRC1	;Diff=0; can use R2 as pointer at right environment.
	004270	016202	000000		PRC2:	MOV SLINK(R2),R2;No, must go up a level.  R2 ← LOC[base of upper area]
	PALX 222	01/15/75  13:42:22	PAGE 58
	INTERP PAL[HAL,HE]	PAGE 6.1 	Interpreter

	004274	005201				INC R1		;R1 ← New difference in levels
	004276	001374				BNE PRC2	;If not yet good, then move up another level
	004300	010260	000000		PRC1:	MOV R2,SLINK(R0);SLINK[new environment] ← correct global environment
					
					      ;Put copies of local variables in new area
	004304	010046				MOV R0,-(SP)	;Stack LOC[new environment]
	004306	017400	000020			MOV @IPC(R4),R0	;R0 ← level-offset pair for an argument
	004312	001417				BEQ PRC3	;If there are no more, go to next phase
	004314	062764	000002	000020	PRC4:	ADD #2,IPC(R4)	;Else bump IPC
	004322	004767	177334			JSR PC,GETARG	;R0 ← LOC[LOC[graph node]]
	004326	017401	000020			MOV @IPC(R4),R1	;R1 ← offset in new block
	004332	062764	000002	000020		ADD #2,IPC(R4)	;Bump IPC
	004340	061601				ADD (SP),R1	;R1 ← LOC[place in new environment to put pointer]
	004342	011011				MOV (R0),(R1)	;new environment gets pointer to LOC[argument graph node]
	004344	017400	000020			MOV @IPC(R4),R0	;R0 ← level-offset pair for an argument
	004350	001361				BNE PRC4	;If there are more, go back and treat them
	004352	062764	000002	000020	PRC3:	ADD #2,IPC(R4)	;Bump IPC one last time
					
					      ;Save the old context in the new area
	004360	012601				MOV (SP)+,R1	;R1 ← LOC[new environment]
	004362	016461	000030	000002		MOV LEV(R4),OLEV(R1)	;Store the old level
	004370	016461	000026	000004		MOV ENV(R4),OENV(R1)	;Store the old environment location
	004376	016461	000020	000006		MOV IPC(R4),OIPC(R1)	;Store the return address
					
					      ;Set up the new context for procedure
	004404	016264	000002	000030		MOV PLEV(R2),LEV(R4)	;New lexical level
	004412	010164	000026			MOV R1,ENV(R4)	;New environment location
	004416	062702	000000			ADD #DSLGTH,R2	;R2 ← Place where execution should begin
	004422	010264	000020			MOV R2,IPC(R4)	;New program counter
	004426	012602				MOV (SP)+,R2	;Restore R2
	004430	005000				CLR R0		;Clear condition code.
	004432	000207				RTS PC		;Done
					
					
					RETURN:
					;Returns from a procedure call to calling program. Since variables are
					;passed by reference, it is not necessary to do any copying of values.
					;All that is needed is to restore the context of the caller and to
					;discard the display.
	004434	016400	000026			MOV ENV(R4),R0	;R0 ← LOC[current environment]
	004440	016064	000002	000030		MOV OLEV(R0),LEV(R4)	;Restore the old lexical level
	004446	016064	000004	000026		MOV OENV(R0),ENV(R4)	;Restore the old environment
	004454	016064	000006	000020		MOV OIPC(R0),IPC(R4)	;Restore the IPC
RETURN+26	4462	6	76	RLFREE	UNDEFINED
	004462	004767	173312			JSR PC,RLFREE	;Release storage of old display
	004466	005000				CLR R0		;Clear condition code.
	004470	000207				RTS PC		;Done
					
					       .MACRO NEWPRC ADDR, PRIORT, STABLK
	PALX 222	01/15/75  13:42:22	PAGE 59
	INTERP PAL[HAL,HE]	PAGE 6.2 	Interpreter

						;Makes a new process, to begin execution at ADDR, with
						;priority PRIORT, and whose status block is at STABLK.
					       .ENDM
					
					SPROUT:
					;Takes one argument: the address of the code which the new interpreter
					;is to execute.  The new interpreter is given an interpreter status
					;block and is then scheduled.
	004472	012700	000000			MOV #ISBS,R0	;R0 ← Size (in words) of an interpreter status block
SPROUT+4	4476	6	90	GTFREE	UNDEFINED
	004476	004767	173276			JSR PC,GTFREE	;R0 ← LOC[new interpreter status block]
	004502	017460	000020	000020		MOV @IPC(R4),IPC(R0)	;new IPC ← jump address
	004510	062764	000002	000020		ADD #2,IPC(R4)		;Bump IPC
	004516	016460	000026	000026		MOV ENV(R4),ENV(R0)	;new ENV ← old ENV
	004524	016460	000030	000030		MOV LEV(R4),LEV(R0)	;new LEV ← old LEV
SPROUT+40	4532	6	95	RO	UNDEFINED
	004532	016746	173242			MOV RO,-(SP)	;Save LOC[new interpreter status block]
SPROUT+44	4536	6	96	INSTSZ	UNDEFINED
	004536	012700	000000			MOV #INSTSZ,R0	;R0 ← Size needed for an interpreter stack
SPROUT+50	4542	6	97	GTFREE	UNDEFINED
	004542	004767	173232			JSR PC,GTFREE	;R0 ← LOC[new interpreter stack]
	004546	012601				MOV (SP)+,R1	;R1 ← LOC[new interpreter status block]
	004550	010060	000022			MOV R0,STKBAS(R0)	;Store away new stack base
SPROUT+62	4554	6	100	INSTSZ	UNDEFINED
	004554	062700	000000			ADD #INSTSZ,R0	;R0 ← LOC[top of new stack]
	004560	010061	000006			MOV R0,SR3(R1)	;Store away new stack pointer
	004564	010161	000010			MOV R1,SR4(R1)	;Store away new interp.status block ptr.
						NEWPRC <INTERP,1,(R0)>	;Sprout new interpreter
						;Makes a new process, to begin execution at INTERP,1,(R0), with
						;priority , and whose status block is at 
	004570	005000				CLR R0		;Clear condition code.
	004572	000207				RTS PC		;Done
	PALX 222	01/15/75  13:42:22	PAGE 60
	INTERP PAL[HAL,HE]	PAGE 7 	Interpreter

					;Routines which return scalars
					;All timings are averages of 1000 runs.  They take into account
					;the cost of the RTS but not the JSR.  It is assumed that GETSCA
					;and GETVEC take no time.
					
					;30 microseconds
					SAS:	;Scalar ← Scalar + Scalar
	004574	172433				LDF @(R3)+,AC0	;AC0 ← arg 2
	004576	172033				ADDF @(R3)+,AC0	;AC0 ← arg2 + arg1
	004600	004767	177236			JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	004604	174010				STF AC0,(R0)	;Store result
	004606	005000				CLR R0		;Clear condition code.
	004610	000207				RTS PC		;Done
					
					;30 microseconds
					SMS:	;Scalar ← scalar * scalar
	004612	172433				LDF @(R3)+,AC0	;AC0 ← arg 2
	004614	171033				MULF @(R3)+,AC0	;AC0 ← arg2 * arg1
	004616	004767	177220			JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	004622	174010				STF AC0,(R0)	;Store result
	004624	005000				CLR R0		;Clear condition code.
	004626	000207				RTS PC		;Done
					
					;33 microseconds
					SDS:	;Scalar ← Scalar / Scalar
	004630	172533				LDF @(R3)+,AC1	;AC1 ← arg 2
	004632	172433				LDF @(R3)+,AC0	;AC0 ← arg 1
	004634	174401				DIVF AC1,AC0	;AC0 ← arg1 / arg2
	004636	004767	177200			JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	004642	174010				STF AC0,(R0)	;Store result
	004644	005000				CLR R0		;Clear condition code.
	004646	000207				RTS PC		;Done
					
					;26 microseconds
					NS:	;Scalar ← -Scalar
	004650	172433				LDF @(R3)+,AC0	;AC0 ← arg
	004652	170700				NEGF AC0	;AC0 ← -arg
	004654	004767	177162			JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	004660	174010				STF AC0,(R0)	;Store result
	004662	005000				CLR R0		;Clear condition code.
	004664	000207				RTS PC		;Done
					
					;96 -- 116 microseconds
					VDV:	;Scalar ← Vector dot Vector
						;S ← (X1X2 + Y1Y2 + Z1Z2) / W1W2
	004666	010246				MOV R2,-(SP)	;Save R2.
	004670	012301				MOV (R3)+,R1	;R1 ← LOC[arg 2]
	004672	012300				MOV (R3)+,R0	;R0 ← LOC[arg 1]
	004674	170400				CLRF AC0	;AC0 ← 0.  Running total
	PALX 222	01/15/75  13:42:22	PAGE 61
	INTERP PAL[HAL,HE]	PAGE 7.1 	Interpreter

	004676	012702	000003			MOV #3,R2	;R2 ← 3:  Length of vector
	004702	172520			VDV1:	LDF (R0)+,AC1	;Form sum of products of first 3 terms
	004704	171121				MULF (R1)+,AC1	;
	004706	172001				ADDF AC1,AC0	;
	004710	077204				SOB R2,VDV1	;Loop until all 3 fields done.
	004712	174410				DIVF (R0),AC0	;Divide by W1
	004714	174411				DIVF (R1),AC0	;Divide by W2.  AC0 now has answer.
	004716	004767	177120			JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	004722	174010				STF AC0,(R0)	;Store result
	004724	012602				MOV (SP)+,R2	;Restore R2
	004726	005000				CLR R0		;Clear condition code.
	004730	000207				RTS PC		;Done
					
					;103 -- 116 microseconds
					PDV:	;Scalar ← Plane dot Vector
						;S ← X1X2 + Y1Y2 + Z1Z2 + W1W2
	004732	010246				MOV R2,-(SP)	;Save R2.
	004734	012301				MOV (R3)+,R1	;R1 ← LOC[arg 2]
	004736	012300				MOV (R3)+,R0	;R0 ← LOC[arg 1]
	004740	170400				CLRF AC0	;AC0 ← 0.  Running total
	004742	012702	000004			MOV #4,R2	;R2 ← 4:  Length of vector and weight
	004746	172520			PDV1:	LDF (R0)+,AC1	;Form sum of products of all 4 terms
	004750	171121				MULF (R1)+,AC1	;
	004752	172001				ADDF AC1,AC0	;
	004754	077204				SOB R2,PDV1	;Loop until all 3 fields done.
	004756	004767	177060			JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	004762	174010				STF AC0,(R0)	;Store result
	004764	012602				MOV (SP)+,R2	;Restore R2
	004766	005000				CLR R0		;Clear condition code.
	004770	000207				RTS PC		;Done
					
					;199 -- 207 microseconds
					NRMV:	;Scalar ← Norm (vector)
						;S ← SQRT(XX + YY+ ZZ) / W
	004772	012301				MOV (R3)+,R1	;R1 ← LOC[arg]
	004774	172421				LDF (R1)+,AC0	;AC0 ← X
	004776	171000				MULF AC0,AC0	;AC0 ← XX
	005000	172521				LDF (R1)+,AC1	;AC1 ← Y
	005002	171101				MULF AC1,AC1	;AC1 ← YY
	005004	172001				ADDF AC1,AC0	;AC0 ← XX + YY
	005006	172521				LDF (R1)+,AC1	;AC1 ← Z
	005010	171101				MULF AC1,AC1	;AC1 ← ZZ
	005012	172001				ADDF AC1,AC0	;AC0 ← XX + YY + ZZ
	005014	010146				MOV R1,-(SP)	;Push LOC[W] onto system stack, to save across SQRTF
NRMV+24		5016	7	94	SQRTF	UNDEFINED
	005016	004767	172756			JSR PC,SQRTF	;AC0 ← SQRT(XX + YY + ZZ)
	005022	174436				DIVF @(SP)+,AC0	;AC0 ← AC0 / W
	005024	004767	177012			JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	005030	174010				STF AC0,(R0)	;Store answer
	PALX 222	01/15/75  13:42:22	PAGE 62
	INTERP PAL[HAL,HE]	PAGE 7.2 	Interpreter

	005032	005000				CLR R0		;Clear condition code.
	005034	000207				RTS PC		;Done
	PALX 222	01/15/75  13:42:22	PAGE 63
	INTERP PAL[HAL,HE]	PAGE 8 	Interpreter

					;Routines which return vectors
					
					;83 -- 91 microseconds
					SMV:	;Vector ← Scalar * Vector
						;X ← S*X,  Y ← S*Y,  Z ← S*Z,  W ← W
	005036	010246				MOV R2,-(SP)	;Save R2
	005040	012301				MOV (R3)+,R1	;R1 ← LOC[vector]
	005042	172433				LDF @(R3)+,AC0	;AC0 ← scalar;
	005044	004767	177002			JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector block]
	005050	012702	000003			MOV #3,R2	;R2 ← 3:  How many fields to handle
	005054	172521			SMV1:	LDF (R1)+,AC1	;AC1 ← next field of vector
	005056	171100				MULF AC0,AC1	;AC1 ← product
	005060	174120				STF AC1,(R0)+	;Store result
	005062	077204				SOB R2,SMV1	;Loop until all 3 fields done.
	005064	012120				MOV (R1)+,(R0)+	;Transfer W
	005066	012120				MOV (R1)+,(R0)+	;  which is 2 words long.
	005070	012602				MOV (SP)+,R2	;Restore R2
	005072	005000				CLR R0		;Clear condition code
	005074	000207				RTS PC		;Done
					
					;281 -- 286 microseconds
					UNITV:	;Vector ← V / Norm(V)
						;S ← SQRT(XX + YY+ ZZ) / W
	005076	010246				MOV R2,-(SP)	;Save R2
	005100	011301				MOV (R3),R1	;R1 ← LOC[arg]
	005102	172421				LDF (R1)+,AC0	;AC0 ← X
	005104	171000				MULF AC0,AC0	;AC0 ← XX
	005106	172521				LDF (R1)+,AC1	;AC1 ← Y
	005110	171101				MULF AC1,AC1	;AC1 ← YY
	005112	172001				ADDF AC1,AC0	;AC0 ← XX + YY
	005114	172521				LDF (R1)+,AC1	;AC1 ← Z
	005116	171101				MULF AC1,AC1	;AC1 ← ZZ
	005120	172001				ADDF AC1,AC0	;AC0 ← XX + YY + ZZ
	005122	010146				MOV R1,-(SP)	;Save R1 across SQRTF
UNITV+26	5124	8	35	SQRTF	UNDEFINED
	005124	004767	172650			JSR PC,SQRTF	;AC0 ← SQRT(XX + YY + ZZ)
	005130	012601				MOV (SP)+,R1	;Restore R1
	005132	174411				DIVF (R1),AC0	;AC0 ← Norm = SQRT / W
	005134	012301				MOV (R3)+,R1	;R1 ← LOC[arg]
	005136	004767	176710			JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector block]
	005142	012702	000003			MOV #3,R2	;R2 ← count of fields
	005146	172521			UNITV1:	LDF (R1)+,AC1	;AC1 ← field of vector
	005150	174500				DIVF AC0,AC1	;divide by norm
	005152	174120				STF AC1,(R0)+	;Store result
	005154	077204				SOB R2,UNITV1	;Loop until done
	005156	012120				MOV (R1)+,(R0)+	;Copy W.
	005160	011110				MOV (R1),(R0)	;   (two words long)
	005162	012602				MOV (SP)+,R2	;Restore R2
	005164	005000				CLR R0		;Clear condition code
	PALX 222	01/15/75  13:42:22	PAGE 64
	INTERP PAL[HAL,HE]	PAGE 8.1 	Interpreter

	005166	000207				RTS PC		;Done
					
					;172 -- 184 microseconds
					CROSV:	;Vector ← Vector cross Vector
						;X ← Y1Z2 - Y2Z1
						;Y ← X2Z1 - X1Z2
						;Z ← X1Y2 - X2Y1
						;W ← W1W2
						;AC0, 1, 2, 3, 4, 5 are garbaged by this routine.
	005170	010246				MOV R2,-(SP)	;Save R2
	005172	011302				MOV (R3),R2	;R2 ← LOC[arg 2]
	005174	004767	176652			JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector block]
	005200	016301	000004			MOV 4(R3),R1	;R1 ← LOC[arg 1].  Must not pop R3 stack yet!
	005204	172461	000014			LDF 14(R1),AC0	;AC0 ← W1
	005210	171062	000014			MULF 14(R2),AC0	;AC0 ← W1W2
	005214	174060	000014			STF AC0,14(R0)	;Store AC0 → W
	005220	172461	000004			LDF 4(R1),AC0	;AC0 ← Y1
	005224	172512				LDF (R2),AC1	;AC1 ← X2
	005226	172662	000004			LDF 4(R2),AC2	;AC2 ← Y2
	005232	172711				LDF (R1),AC3	;AC3 ← X1
	005234	174304				STF AC3,AC4	;AC4 ← X1
	005236	174005				STF AC0,AC5	;AC5 ← Y1
	005240	171302				MULF AC2,AC3	;AC3 ← X1Y2
	005242	171001				MULF AC1,AC0	;AC0 ← X2Y1
	005244	173300				SUBF AC0,AC3	;AC3 ← X1Y2 - X2Y1
	005246	174360	000010			STF AC3,10(R0)	;Z ← AC3
	005252	172462	000010			LDF 10(R2),AC0	;AC0 ← Z2
	005256	172761	000010			LDF 10(R1),AC3	;AC3 ← Z1
	005262	171004				MULF AC4,AC0	;AC0 ← X1Z2
	005264	171103				MULF AC3,AC1	;AC1 ← X2Z1
	005266	173100				SUBF AC0,AC1	;AC1 ← X2Z1 - X1Z2
	005270	174160	000004			STF AC1,4(R0)	;Y ← AC1
	005274	172462	000010			LDF 10(R2),AC0	;AC0 ← Z2
	005300	171005				MULF AC5,AC0	;AC0 ← Y1Z2
	005302	171302				MULF AC2,AC3	;AC3 ← Y2Z1
	005304	173003				SUBF AC3,AC0	;AC0 ← Y1Z2 - Y2Z1
	005306	174010				STF AC0,(R0)	;X ← AC0
	005310	012363	000002			MOV (R3)+,2(R3)	;Put result cell where first argument was
	005314	005723				TST (R3)+	;Put stack pointer in right place
	005316	012602				MOV (SP)+,R2	;Restore R2
	005320	005000				CLR R0		;Clear condition code
	005322	000207				RTS PC		;Done
					
					;283 -- 324 microseconds
					TMV:	;Vector ← Trans * Vector
	005324	010246				MOV R2,-(SP)	;Save R2
	005326	011302				MOV (R3),R2	;R2 ← LOC[vector]
	005330	016300	000002			MOV 2(R3),R0	;R0 ← LOC[trans]
	005334	170401				CLRF AC1	;X ← 0
	PALX 222	01/15/75  13:42:22	PAGE 65
	INTERP PAL[HAL,HE]	PAGE 8.2 	Interpreter

	005336	170402				CLRF AC2	;Y ← 0
	005340	170403				CLRF AC3	;Z ← 0
	005342	012701	000004			MOV #4,R1	;R1 ← How many columns left to go
	005346	172422			TMV1:	LDF (R2)+,AC0	;AC0 ← field of vector
	005350	174005				STF AC0,AC5	;AC5 ← copy of AC0
	005352	171020				MULF (R0)+,AC0	;
	005354	172100				ADDF AC0,AC1	;Add partial result to X
	005356	172405				LDF AC5,AC0	;Restore AC0
	005360	171020				MULF (R0)+,AC0	;
	005362	172200				ADDF AC0,AC2	;Add partial result to Y
	005364	172405				LDF AC5,AC0	;Restore AC0
	005366	171020				MULF (R0)+,AC0	;
	005370	172300				ADDF AC0,AC3	;Add partial result to Z.
	005372	005720				TST (R0)+	;Skip bottom row
	005374	005720				TST (R0)+	;  (2 words long)
	005376	077115				SOB R1,TMV1	;Go back to do all 4 columns.
	005400	004767	176446			JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector]
	005404	174120				STF AC1,(R0)+	;Store X
	005406	174220				STF AC2,(R0)+	;Store Y
	005410	174320				STF AC3,(R0)+	;Store Z
	005412	016220	177774			MOV -4(R2),(R0)+;Copy W from the vector
	005416	016210	177776			MOV -2(R2),(R0)	;  (2 words long)
	005422	012363	000002			MOV (R3)+,2(R3)	;Put result cell where first argument was
	005426	005723				TST (R3)+	;Put stack pointer in right place
	005430	012602				MOV (SP)+,R2	;Restore R2
	005432	005000				CLR R0		;Clear condition code
	005434	000207				RTS PC		;Done
					
	PALX 222	01/15/75  13:42:22	PAGE 66
	INTERP PAL[HAL,HE]	PAGE 9 	Interpreter

					;routines which return a trans
	PALX 222	01/15/75  13:42:22	PAGE 67
	TEST PAL[HAL,HE]	PAGE 2.3 	Interpreter

						;Currently under test
					;Data areas
		005636				.BLKW 100
		005640			STACK:	.BLKW 1
		005740			ARG1:	.BLKW 32.	;Long enough for a trans
		006040			ARG2:	.BLKW 32.	;Long enough for a trans
		006140			RES:	.BLKW 32.	;Long enough for a trans
	006140	003170			CURIN:	INBUF		;Current line pointer
					
					
	PALX 222	01/15/75  13:42:22	PAGE 68
	TEST PAL[HAL,HE]	PAGE 3 	Interpreter

					;UTILITY INPUT ROUTINES FOR DEBUGGING INTERP
					
					;Routine to read a floating number into location pointed to by R0.
	006142	010046			FLREAD:	MOV R0,-(SP)	;Save arg.
	006144	016700	177770			MOV CURIN,R0	;R0 ← current line pointer
	006150	004767	172512		FLRD2:	JSR PC,RELSCN	;AC0 ← number typed in
	006154	005701				TST R1		;Got anything?
	006156	001407				BEQ FLRD1	;Yes.
	006160	012700	003170			MOV #INBUF,R0	;No.  Prepare to read a new line.
	006164	004767	174030			JSR PC,INSTR	;
	006170	012700	003170			MOV #INBUF,R0	;
	006174	000765				BR FLRD2	;
	006176	010067	177736		FLRD1:	MOV R0,CURIN	;New current line pointer
	006202	174036				STF AC0,@(SP)+	;Put number in desired place.
	006204	000207				RTS PC		;Done
					
					;Routine to get a scalar argument into arg1 or arg2, whichever R0 points to
					SCALIN:	OUTSTR SCLMES	;Say we want a scalar
	006206	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	006210	010146				MOV R1,-(SP)	;Save R1.
	006212	012700	006242			MOV #SCLMES,R0	;Load up the string to be output
	006216	004767	172256			JSR PC,TYPSTR	;Call the string output utility routine.
	006222	012601				MOV (SP)+,R1	;Restore R1.
	006224	012600				MOV (SP)+,R0	;Restore R0.
	006226	010043				MOV R0,-(R3)	;Stack the argument
	006230	105077	177704			CLRB @CURIN	;Force a move to new line.
	006234	004767	177702			JSR PC,FLREAD	;Read it.
	006240	000207				RTS PC		;Done
					SCLMES:	ASCIE </SCALAR, PLEASE: />
	006242	   123		
	006243	   103		
	006244	   101		
	006245	   114		
	006246	   101		
	006247	   122		
	006250	   054		
	006251	   040		
	006252	   120		
	006253	   114		
	006254	   105		
	006255	   101		
	006256	   123		
	006257	   105		
	006260	   072		
	006261	   040		
	006262	   000		
					       .ASCIZ /SCALAR, PLEASE: /
		006264			       .EVEN
						
	PALX 222	01/15/75  13:42:22	PAGE 69
	TEST PAL[HAL,HE]	PAGE 3.1 	Interpreter

					;Routine to get a vector argument into arg1 or arg2, whichever R0 points to
	006264	010246			VECTIN:	MOV R2,-(SP)	;Save R2
						OUTSTR VCTMES	;Say we want a vector
	006266	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	006270	010146				MOV R1,-(SP)	;Save R1.
	006272	012700	006346			MOV #VCTMES,R0	;Load up the string to be output
	006276	004767	172176			JSR PC,TYPSTR	;Call the string output utility routine.
	006302	012601				MOV (SP)+,R1	;Restore R1.
	006304	012600				MOV (SP)+,R0	;Restore R0.
	006306	010043				MOV R0,-(R3)	;Stack the destination
	006310	010046				MOV R0,-(SP)	;and save a copy on the other stack, too.
	006312	105077	177622			CLRB @CURIN	;Force a move to new line.
	006316	012702	000004			MOV #4,R2	;Need to read 4 scalars
	006322	004767	177614		VCTIN1:	JSR PC,FLREAD	;Get one
	006326	011600				MOV (SP),R0	;Retrieve location
	006330	062700	000004			ADD #4,R0	;Update location
	006334	010016				MOV R0,(SP)	;Save it again
	006336	077207				SOB R2,VCTIN1	;Go back and pick up other fields
	006340	005726				TST (SP)+	;Clean off stack
	006342	012602				MOV (SP)+,R2	;Restore R2.
	006344	000207				RTS PC		;Done
				VCTMES:	ASCIE </I NEED A VECTOR.  GIVE ME 4 SCALARS, PLEASE:
					/>
	006346	   111		
	006347	   040		
	006350	   116		
	006351	   105		
	006352	   105		
	006353	   104		
	006354	   040		
	006355	   101		
	006356	   040		
	006357	   126		
	006360	   105		
	006361	   103		
	006362	   124		
	006363	   117		
	006364	   122		
	006365	   056		
	006366	   040		
	006367	   040		
	006370	   107		
	006371	   111		
	006372	   126		
	006373	   105		
	006374	   040		
	006375	   115		
	006376	   105		
	006377	   040		
	PALX 222	01/15/75  13:42:22	PAGE 70
	TEST PAL[HAL,HE]	PAGE 3.2 	Interpreter

	006400	   064		
	006401	   040		
	006402	   123		
	006403	   103		
	006404	   101		
	006405	   114		
	006406	   101		
	006407	   122		
	006410	   123		
	006411	   054		
	006412	   040		
	006413	   120		
	006414	   114		
	006415	   105		
	006416	   101		
	006417	   123		
	006420	   105		
	006421	   072		
	006422	   015		
	006423	   012			       .ASCIZ /I NEED A VECTOR.  GIVE ME 4 SCALARS, PLEASE:
	006424	   000		
					/
		006426			       .EVEN
					
					;Routine to get a trans argument into arg1 or arg2, whichever R0 points to
	006426	010246			TRNSIN:	MOV R2,-(SP)	;Save R2
						OUTSTR TRNMES	;Say we want a vector
	006430	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	006432	010146				MOV R1,-(SP)	;Save R1.
	006434	012700	006506			MOV #TRNMES,R0	;Load up the string to be output
	006440	004767	172034			JSR PC,TYPSTR	;Call the string output utility routine.
	006444	012601				MOV (SP)+,R1	;Restore R1.
	006446	012600				MOV (SP)+,R0	;Restore R0.
	006450	105077	177464			CLRB @CURIN	;Force a move to new line.
	006454	010043				MOV R0,-(R3)	;Stack the destination
	006456	010046				MOV R0,-(SP)	;and save a copy on the other stack, too.
	006460	012702	000020			MOV #16.,R2	;Need to read 16 scalars
	006464	004767	177452		TRNSN1:	JSR PC,FLREAD	;Get one
	006470	062716	000004			ADD #4,(SP)	;Update location
	006474	011600				MOV (SP),R0	;  and retrieve it.
	006476	077206				SOB R2,TRNSN1	;Go back and pick up other fields
	006500	005726				TST (SP)+	;Clean off stack
	006502	012602				MOV (SP)+,R2	;Restore R2.
	006504	000207				RTS PC		;Done
				TRNMES:	ASCIE </I NEED A TRANS.  GIVE ME 16 SCALARS, PLEASE:
					/>
	006506	   111		
	006507	   040		
	006510	   116		
	PALX 222	01/15/75  13:42:22	PAGE 71
	TEST PAL[HAL,HE]	PAGE 3.3 	Interpreter

	006511	   105		
	006512	   105		
	006513	   104		
	006514	   040		
	006515	   101		
	006516	   040		
	006517	   124		
	006520	   122		
	006521	   101		
	006522	   116		
	006523	   123		
	006524	   056		
	006525	   040		
	006526	   040		
	006527	   107		
	006530	   111		
	006531	   126		
	006532	   105		
	006533	   040		
	006534	   115		
	006535	   105		
	006536	   040		
	006537	   061		
	006540	   066		
	006541	   040		
	006542	   123		
	006543	   103		
	006544	   101		
	006545	   114		
	006546	   101		
	006547	   122		
	006550	   123		
	006551	   054		
	006552	   040		
	006553	   120		
	006554	   114		
	006555	   105		
	006556	   101		
	006557	   123		
	006560	   105		
	006561	   072		
	006562	   015		
	006563	   012			       .ASCIZ /I NEED A TRANS.  GIVE ME 16 SCALARS, PLEASE:
	006564	   000		
					/
		006566			       .EVEN
					
					;Routine to print the scalar argument pointed to by R0
	006566	172410			SCLOUT:	LDF (R0),AC0	;Pick up number.
	PALX 222	01/15/75  13:42:22	PAGE 72
	TEST PAL[HAL,HE]	PAGE 3.4 	Interpreter

	006570	012700	003314			MOV #OUTBUF,R0	;
	006574	004767	173116			JSR PC,CVG	;Convert it to string
	006600	012700	003314			MOV #OUTBUF,R0	;
	006604	004767	171670			JSR PC,TYPSTR	;Print it.
	006610	000207				RTS PC		;Done
					
					;Routine to print the vector argument pointed to by R0
	006612	010246			VECOUT:	MOV R2,-(SP)	;Save R2
	006614	010346				MOV R3,-(SP)	;Save R3
	006616	010002				MOV R0,R2	;R2 ← LOC[next field]
	006620	012703	000004			MOV #4,R3	;Need to print 4 fields
	006624	172422			VCOUT1:	LDF (R2)+,AC0	;Pick up a field
	006626	012700	003314			MOV #OUTBUF,R0	;
	006632	004767	173060			JSR PC,CVG	;Convert it to string
	006636	012700	003314			MOV #OUTBUF,R0	;
	006642	004767	171632			JSR PC,TYPSTR	;Print it.
	006646	077312				SOB R3,VCOUT1	;Do all this 4 times
	006650	012603				MOV (SP)+,R3	;Restore R3
	006652	012602				MOV (SP)+,R2	;Restore R2
	006654	000207				RTS PC		;Done
					
	PALX 222	01/15/75  13:42:22	PAGE 73
	TEST PAL[HAL,HE]	PAGE 4 	Interpreter

					; program initialization
	006656	000005			START:	RESET
	006660	012706	000500			MOV #500,SP	;initialize stack
	006664	005067	171106			CLR PS		;initialize processor status
	006670	005067	163650		CLKIN:	CLR CLKCNT	;clear clock registers- trap restart
	006674	005067	163642			CLR CLKSET
	006700	005067	163634			CLR CLKS
	006704	012700	043400			MOV #043400,R0	;No interrupts, single precision
	006710	170100				LDFPS R0	;Load Floating Processor Status
	006712	012700	000016			MOV #16,R0	;Field length
	006716	012701	000010			MOV #10,R1	;Decimal digits
	006722	004767	172320			JSR PC,FORMAT	;
	006726	012703	005636			MOV #STACK,R3	;Set up argument stack
					
					TEST:	CRLF		;
						OUTSTR CRLFX	;Carriage return, line feed.
	006732	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	006734	010146				MOV R1,-(SP)	;Save R1.
	006736	012700	000626			MOV #CRLFX,R0	;Load up the string to be output
	006742	004767	171532			JSR PC,TYPSTR	;Call the string output utility routine.
	006746	012601				MOV (SP)+,R1	;Restore R1.
	006750	012600				MOV (SP)+,R0	;Restore R0.
						CRLF
						OUTSTR CRLFX	;Carriage return, line feed.
	006752	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	006754	010146				MOV R1,-(SP)	;Save R1.
	006756	012700	000626			MOV #CRLFX,R0	;Load up the string to be output
	006762	004767	171512			JSR PC,TYPSTR	;Call the string output utility routine.
	006766	012601				MOV (SP)+,R1	;Restore R1.
	006770	012600				MOV (SP)+,R0	;Restore R0.
	006772	012700	005640			MOV #ARG1,R0	;
	006776	004767	177204			JSR PC,SCALIN	;Get first argument
	007002	012700	005740			MOV #ARG2,R0	;
	007006	004767	177174			JSR PC,SCALIN	;Get second argument
	007012	012704	001750			MOV #1000.,R4	;Do the test 1000 times
	007016	005067	163520			CLR CLKSET	;
	007022	012767	000021	163510		MOV #21,CLKS	;Start counting up
	007030	012703	005636		TST1:	MOV #STACK,R3	;Set up argument stack
	007034	012743	005640			MOV #ARG1,-(R3)	;Restore interpreter stack
	007040	012743	005740			MOV #ARG2,-(R3)	;  with both arguments.
	007044	004767	175524			JSR PC,SAS	;Call the routine under test
	007050	077411				SOB R4,TST1	;Do it over and over
	007052	005067	163462			CLR CLKS	;Stop the clock
	007056	016700	163462			MOV CLKCNT,R0	;R0 ← Number of 10 micros elapsed
	007062	004767	171430			JSR PC,TYPDEC	;Print it.
	007066	012300				MOV (R3)+,R0	;
	007070	004767	177472			JSR PC,SCLOUT	;Print answer
	007074	000716				BR TEST		;Over and over
					
	PALX 222	01/15/75  13:42:22	PAGE 74
	TEST PAL[HAL,HE]	PAGE 4.1 	Interpreter

					
					;The rest of this will never get executed.  Left here for historical reasons:
		000000			.IFNZ 0
						MOV #1000.,R3	;Do the test 1000 times
						CLR CLKSET	;
						MOV #21,CLKS	;Start counting up
					TST1:	STF AC0,-(SP)	;Save AC0
						JSR PC,SQRTF	;AC0 ← SQRT(AC0)
						LDF (SP)+,AC0	;Restore AC0
						SOB R3,TST1	;Do it over and over
						CLR CLKS	;Stop the clock
						MOV CLKCNT,R0	;R0 ← Number of 10 micros elapsed
						JSR PC,TYPDEC	;Print it.
						CRLF		;
						MOV #STRING,R0	;
						JSR PC,CVG	;Print answer
						OUTSTR STRING	;
						BR TEST		;Loop
					
						HALERR TSTDON	;Finished here.  Terminate cleanly.
					TSTDON:	ASCIE /Done./
					.ENDC
		006656			.END START
	PALX 222	01/15/75  13:42:22	PAGE 75
	TEST PAL[HAL,HE]	PAGE 4 	***SYMBOL TABLE***      

	AC0	000000RH		FLRD1	006176		KBIR	177562		PDV1	004746	
	AC1	000001RH		FLRD2	006150		KBIS	177560		PIC2	001134	
	AC2	000002RH		FLREAD	006142		KBOR	177566		PICK	000720	
	AC3	000003RH		FLUSH	004216		KBOS	177564		PLEV	000002H	
	AC4	000004RH		FORM	000004H		LEV	000030H		POP	004166	
	AC5	000005RH		FORMAT	001246		LINKB	000004H		PRC1	004300	
	ARG1	005640		FSLGTH	000000H		LINKF	000002H		PRC2	004270	
	ARG2	005740		FSTBLK	000006H		LSTBLK	000004H		PRC3	004352	
	BUFHDR	000000H		FSTBUF	000022H		LSTBUF	000024H		PRC4	004314	
	CCNT	002400		GCFG	000010H		LVARS	000010H		PROC	004226	
	CDONE	001224		GETARG	003662		MAPRTN	000002H		PRTF	002020	
	CHANGE	000000U		GETDG	002076		MARK0	006400H		PRVBUF	000002H	
	CHGCOD	000002H		GETSCA	004042		MARK1	006401H		PRVGN	000002H	
	CHKDG	000752		GETVAL	000000U		MARK2	006402H		PS	177776	
	CHKDN	001214		GETVEC	004052		MARK3	006403H		PT	002432	
	CHKDP	001020		GNCHGS	000014H		MARK4	006404H		R0	000000R	
	CHKEX	001060		GNCLCS	000012H		MARK5	006405H		R1	000001R	
	CHKSZ	002136		GNDEPS	000010H		MAXIDF	000030H		R2	000002R	
	CHNGE	004126		GNVAL	000006H		METH	000000H		R3	000003R	
	CLKCNT	172544		GTERR	003724		MSIGN	002410		R4	000004R	
	CLKIN	006670		GTFREE	000000U		NALLOC	000026H		R5	000005R	
	CLKS	172540		GTMS1	003772		NEEDED	000002H		RADIX	000544	
	CLKSET	172542		GTRG1	003716		NFER	001326		RELSCN	000666	
	CLKTRP	000104H		GTRG2	003706		NFREE	000030H		RES	006040	
	COPY	004174		GTVAL	004062		NMIN	000012H		RETURN	004434	
	CRLFX	000626		HCOR	077776		NNNN	006402H		RF	000005RH	
	CROSV	005170		IBUF	000150H		NORM	001170		RLFREE	000000U	
	CURIN	006140		ICR	000024H		NPCT	000014H		RNORM	001044	
	CVE	001454		IDFLAG	000000H		NPERB	000006H		RO	000000U	
	CVF	001374		II	000000H		NRMV	004772		RSTFOR	001356	
	CVG	001716		ILGINS	000010H		NS	004650		RUG	050000	
	DATUM	000000H		IN2	002224		NUM	002416		RUGMES	000631	
	DBS	002402		IN3	002310		NXTBUF	000000H		RUNE	002004	
	DGLST	002434		IN4	002350		NXTCHG	000000H		RUNF	002012	
	DIG	002424		INBUF	003170		NXTCLC	000000H		SAS	004574	
	DIG2	001136		INSEND	000046		NXTGN	000000H		SCALIN	006206	
	DIGLP	002052		INSTR	002220		NXTMTH	000002H		SCLMES	006242	
	DSLGTH	000000H		INSTSZ	000000U		NXTSID	000016H		SCLOUT	006566	
	ENV	000026H		INTCPL	003470		OBUF	000160H		SDS	004630	
	EPRT	001630		INTER1	003500		OENV	000004H		SETBS	002172	
	ERRTRP	000004H		INTERP	003440		OIPC	000006H		SIDCHN	000000H	
	ESIGN	002412		INTMS1	003546		OLDD	002430		SIDCNT	000000H	
	EXCN	001100		INTOPS	003614		OLDW	002426		SIDHED	000000H	
	EXPON	002414		INTSTS	003476		OLEV	000002H		SIZE	000004H	
	FERM	001330		INVMRK	000004H		OUTBUF	003314		SLINK	000000H	
	FFREE	000020H		IPC	000020H		PC	000007R		SMS	004612	
	FLOAT	000001H		ISBS	000000		PDV	004732		SMV	005036	
	PALX 222	01/15/75  13:42:22	PAGE 76
	TEST PAL[HAL,HE]	PAGE 4 	***SYMBOL TABLE***      

	SMV1	005054		VDV1	004702	
	SP	000006R		VECOUT	006612	
	SPC	000016H		VECTIN	006264	
	SPCHDR	000000H		WIDTH	002422	
	SPROUT	004472		WORD0	000000H	
	SQRTF	000000U		WTCH	002206	
	SR0	000000H		WTDP	002072	
	SR1	000002H		WTSP	002202	
	SR2	000004H		XPRT	001662	
	SR3	000006H	
	SR4	000010H	
	SRF	000012H	
	SSP	000014H	
	STA	000032H	
	STACK	005636	
	START	006656	
	STAT	002406	
	STKBAS	000022H	
	STRT11	000500	
	TAG	177777H	
	TAGID	177776H	
	TEMP	000000H	
	TEN	002740	
	TENLST	002734	
	TENTH	002730	
	TEST	006732	
	TMV	005324	
	TMV1	005346	
	TOLGE	002104	
	TRNMES	006506	
	TRNSIN	006426	
	TRNSN1	006464	
	TSLOOP	000504	
	TST1	007030	
	TYPCHR	000566	
	TYPDEC	000516	
	TYPDIG	000536	
	TYPOCT	000526	
	TYPOUT	000560	
	TYPRET	000624	
	TYPSTR	000500	
	UNITV	005076	
	UNITV1	005146	
	VCOUT1	006624	
	VCTIN1	006322	
	VCTMES	006346	
	VDV	004666	
	PALX 222	01/15/75  13:42:22	PAGE 77
	TEST PAL[HAL,HE]	PAGE 4 	***SYMBOL TABLE***      


11 ERRORS DETECTED

1.4 WDS AVG INSN LENGTH

31 SECONDS RUN-TIME